简体   繁体   中英

Push and pull word content control data to and from Designed VBA form

I got a question, a couple in fact. (sorry for not formatting correctly, i tried but it just doesnt "work") I've designed a template for my job application processes, got the content controls working fine pushing data from my form to the document. Now i wonder, how to retrieve such data back into the form when i open the document again?

Working short word code:

  Option Explicit
   'Coded by Etrola Limited-Now terminated /Erik L Thoresen
   'Pending change
   'Revision 1 CC and form

  Private Sub cmdFillForm_Click()
   'Fill letter elements (content controls) from userform, works fine to fill text in controls
    Dim cc As ContentControl
    For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccCompany" Then
            cc.Range.Text = Me.txtCompany
            Exit For
        End If
    Next cc
    End Sub

How should I then best place code to place this? Debug.Print cc.Range.text to keep my form "live to data in doc?"

And now for my second question: In my Excel database, a log of different activities performed, i got the urge of creating my application from a range of declared cells as filename, and the data from those shall also be entered into content controls when calling the form to create a new application with a filename given by these ranged cells. Lets say: I have an active line in a table in that sheet, the last row with 5 or more cells in a row.

I can also have entered any number of interesting jobs for a date, and by a click of a floating or other form of way to create these applications type of menu, all are created with the desired data.

  1. How do i call that template?
  2. How do i define either ranged cells (by date would be nice, but also ActiveRow)?

Excel code:

Option Explicit
Sub TransferDataToWord()
  Dim wdApp As Word.Application
  Dim wdDoc As Word.Document
  Dim strDocName As String
  Dim MyRange As Range
  Dim fNamePt1 As String
  Dim fNamePt2 As String
  Dim fNamePt3 As String
  Dim fNamePt4 As String
  Dim fNamePt5 As String
  fNamePt1 = Range.Count '?
  fNamePt2 = Range.Count '?
  fNamePt3 = Range.Count '?
  fNamePt4 = Range.Count '?
  fNamePt5 = Range.Count '?

  On Error Resume Next

  Set wdApp = GetObject(, "word.application")
  Set wdDoc = wdApp.Documents.Add
    wdDoc.Content.InsertAfter Range
      If Err.Number = 429 Then
       Err.Clear
        Set wdApp = CreateObject("word.application")
      End If
    wdApp.Visible = True
      strDocName = "C:\Myfolder\" 'Søknad' "&fNamePt1 &fNamePt2 &fNamePt3 &fNamePt4)
      If Dir(strDocName) = "" Then
        MsgBox "The file " & strDocName & vbCrLf & "wasn't found " & vbCrLf & "C:\MyFolder\.", vbExclamation, " The document doesn't exist "
       End Sub
     End If

wdApp.Activate
 Set wdDoc = wdApp.Documents(strDocName)
   If wdDoc Is Nothing Then 
     Set wdDoc = Documents(strDocName)
       wdDoc.Activate
       wdDoc.MyRange.Paste
       wdDoc.Save
      wdApp.Quit

Set wdDoc = Nothing
Set wdApp = Nothing
Application.CutCopyMode = False

Thank you for your reply. Now, for calling this word template from a embedded button in my excel sheet =EMBED("Forms.CommandButton.1";"") named cmdCreateApplication, should i better use like this:

`oWord.Documents.Add "<Path to my template>\MyTemplate.dot"`

or your example? My code now looks like this:(Yet to make it work) I know i have gotten something wrong. Since i've forgotten too much.

Private Sub cmdCreateApplication_Click(ByVal oRng As Range)
'
'Opens desired template to fill in data form range of cells
'Dim wApp As Word.Application
Set wApp = CreateObject(, "Word.Application")
    wApp.DisplayAlerts = False
'Opens template to create document
Documents.Add Template:="C:\myfolder\Norwegian Application Template 2.dotm"

'Below Tells to keep values in memory
Dim MyDate As String
Dim MyJobTitle As String
Dim MyDocType As String
Dim MyJobRefNo As String
Dim TheirRefNo As String
Dim JobWebSite As String
Dim Company As String
Dim AttName As String
Dim AttTitle As String
Dim AttEmail As String
Dim RecFirm As String
Dim Address As String

'Below Describes what to extract from Excel and keep in memory to fill into word document objects
MyDate = oRng.Offset(0, 1).Text 'Date of application /first contact
MyDocType = oRng.Offset(0, 5).Text 'File name part 1 Identifier of doc type, if application, e-mail or CV
MyJobTitle = oRng.Offset(0, 6).Text 'File name part 2 Job title
RecFirm = oRng.Offset(0, 15).Text 'File name part 3 Recruitment agancy, if exist
Company = oRng.Offset(0, 16).Text 'File name part 4 Hiring Company, if exist
MyJobRefNo = oRng.Offset(0, 8).Text 'File name part 5 Reference number (if website)
AttName = oRng.Offset(0, 11).Text 'Contact name
AttEmail = oRng.Offset(0, 13).Text 'Contact e-mail
AttTitle = oRng.Offset(0, 12).Text 'Contact title
JobWebSite = oRng.Offset(0, 10).Text 'Link to job board
TheirRefNo = oRng.Offset(0, 9).Text 'Their reference nr if any
Address = oRng.Offset(0, 17).Text 'Company Adress

On Error Resume Next
'
Set wdApp = GetObject(, "Word.Application")
     If Err.Number = 429 Then
        Err.Clear
        Set wdApp = CreateObject("Word.Application")
     End If
strDocName = "C:\myfolder\ MyDocType &wdKeySpacebar &MyJobTitle &wdKeySpacebar &RecFirm &wdKeySpacebar &Company &wdKeySpacebar &MyJobRefNo"



'Below describes where stored data shall be placed before assigning file name and save
Dim cc As ContentControl
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccCompany" Then
            Company = Me.txtCompany 'Fills data into form
            Company = cc.Range.Text 'Fills data into content controls
            Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccDate" Then
            MyDate = Me.txtApplicationDate
            MyDate = cc.Range.Text
            Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccJobTitle" Then
            MyJobTitle = Me.txtJobTitle
            MyJobTitle = cc.Range.Text
            Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccRecFirm" Then
            RecFirm = Me.txtRecFirm
            RecFirm = cc.Range.Text
            Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccJobWebSite" Then
            JobWebSite = cc.Range.Text
            JobWebSite = Me.txtJobPostWeb
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccAttEmail" Then
            AttEmail = cc.Range.Text
            AttEmail = Me.txtAttEmail
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccAttTitle" Then
            AttTitle = cc.Range.Text
            AttTitle = Me.txtAttTitle
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccAttName" Then
            AttName = cc.Range.Text
            AttName = Me.txtAttName
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccTheirRefNo" Then
            TheirRefNo = cc.Range.Text
            TheirRefNo = Me.txtTheirRefNo
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccMyRefNo" Then
            MyJobRefNo = cc.Range.Text
            MyJobRefNo = Me.txtMyJobRefNo
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccAddress" Then
           Address = cc.Range.Text
           Address = Me.txtCompanyStreetAddress
    Exit For
        End If
    Next cc
For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccRequirements" Then
            Requirements = cc.Range.Text
            Requirements = Me.txtRequirements
    Exit For
        End If
    Next cc
End Sub

To keep the form synchronized with the document, I would place some code in the forms Open() event, doing exactly the opposite assignment:

Private sub Form_open()
    Dim cc As ContentControl
    For Each cc In ActiveDocument.ContentControls
        If cc.Title = "ccCompany" Then
            Me.txtCompany = cc.Range.Text
            Exit For
        End If
    Next cc
End Sub

I'm afraid I don't fully understand your second question, but I think in this case I would pass the Range object as a parameter to the function that creates the Word document. This way you divide the responsibilities between different procedures.

Sub TransferDataToWord(byval oRng as Range)
     ...
     fNamePt1 = oRng.Offset(0,1).Text
     fNamePt2 = oRng.Offset(0,2).Text
     ...
     On error resume next
     Set wdApp = GetObject(,"Word.Application")
     If Err.Number = 429 Then 
        Err.Clear
        Set wdApp = CreateObject("Word.Application")
     End If
     ...

Hope you find what you're looking for. Regards.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM