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