Question

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.

How do i call that template?
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

Answer 1

感谢您的回复。现在，要从名为cmdCreateApplication的excel表=EMBED("Forms.CommandButton.1";"")中的嵌入式按钮调用此单词模板，我应该更好地使用这样：

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

还是你的例子？我的代码现在看起来像这样:(但要使它工作）我知道我有错误。因为我忘记了太多。

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

Answer 2

为了使表单与文档保持同步，我会在表单Open（）事件中放置一些代码，完成相反的任务：

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

我担心我不完全理解你的第二个问题，但我认为在这种情况下我会将Range对象作为参数传递给创建Word文档的函数。这样就可以在不同的程序之间划分责任。

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
     ...

希望你找到你想要的东西。问候。

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

2 个答案: