I need a macro that places a conditional merge field with nested IF statements. Most users just copy the merge fields from one document and paste them into their final draft. However, there are numerous conditional merge fields to choose from. Using a command button that inputs the merge field instead of copying and pasting will illuminate user error and speed up this process. Any help is much appreciated.
A macro that places a multi-nested conditional IF statement into a
document.
Below is the code I created. Where it reads, “truetext:=”True,” is where I need to insert another merge field.
Thank you for reading and for your interest!
Dim doc As Word.Document
Dim mName As String
Dim dField As Word.MailMergeDataField
Set doc = ActiveDocument
doc.MailMerge.Fields.Add Range:=Selection.Range, Name:="""Client_FirstName"""
Selection.TypeText Text:=" "
doc.MailMerge.Fields.AddIf Range:=Selection.Range, _
mergefield:="""Client_MiddleName""", Comparison:=wdMergeIfIsNotBlank, _
truetext:="True", _
falsetext:="False"
Selection.TypeText Text:=" "
doc.MailMerge.Fields.Add Range:=Selection.Range, _
Name:="""Client_LastName"""
doc.MailMerge.Fields.AddIf Range:=Selection.Range, _
mergefield:="""Client_NameSuffix""", Comparison:=wdMergeIfIsNotBlank, _
truetext:="""Client_NameSuffix""", _
falsetext:=""
Selection.TypeText Text:=" "
Related
I am trying to use VBA in an open .docm file to open a 2nd read only .docx file and then insert -> object -> text from file (a 3rd read only .docx stored within the same folder).
The below code correctly opens and merges the two files but when it comes to saving the output it returns a Run-Time 13 “mismatch” error. My limited understanding leads me to believe that at the point where I am saving, the active document reference is still the original .docm and it is the .docx designation that then causes the conflict.
I am really struggling to manage the active document reference to avoid this. Presumably I am missing something very simple, all assistance is very gratefully received.
Documents.Open ActiveDocument.Path & "\DocA.docx", Visible:=True
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
ActiveDocument.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
ActiveWindow.Close
Putting flesh on John Korchok's comment:
Sub deleteme3()
Dim oldDoc As Document
Set oldDoc = Documents.Open(ActiveDocument.Path & "\DocA.docx", Visible:=True)
oldDoc.Activate
selection.Collapse Direction:=wdCollapseEnd 'to insert at end of document
selection.Range.InsertBreak Type:=wdPageBreak
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
oldDoc.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
oldDoc.Close
Set oldDoc = Nothing
End Sub
Note this puts the inserted document at the end of the original document. You may want to use a next-page section break instead if there is header/footer differentiation. If you need that, please comment and I will include it.
There are a number of break types. Here is the enumeration of all of them if you are interested. The following types create a page break of one sort or another:
wdPageBreak (the default)
wdSectionBreakNextPage
wdSectionBreakOddPage (starts section on next odd-numbered page - good for chapters)
wdSectionBreakEvenPage (starts section on next even-numbered page - rarely used)
If wanting to preserve headers and footers additional code would be needed.
(Every section in a Word document has three headers and three footers, even if they are not displayed or used.)
' Break Link to Previous in newly added section for all of the headers and footers
Dim oHeaderFooter As HeaderFooter
Dim iCounter As Long
Let iCounter = ActiveDocument.Sections.Count
' break link in headers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Headers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
' repeat for footers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Footers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
I need help with some code. I built a User Form in word using Bookmarks as references to where the text in each TextBox should go, I was able to accomplish that. The challenge I'm having now is using the Split Function. I want to grab each word from TextBox3 and place them in a table, then I want to search each word in an excel database and retrieve the info on the cell next to it (in a Vlookup sort of way). Each word from the TextBox3 should be in a different line.
Here is the code:
Private Sub CommandButton1_Click()
With ActiveDocument
.Bookmarks("bmCN").Range _
.InsertBefore TextBox1
.Bookmarks("bmOriJob").Range _
.InsertBefore TextBox2
.Bookmarks("bmOptJob").Range _
.InsertBefore TextBox3
.Bookmarks("bmJobD").Range _
.InsertBefore TextBox4
.Bookmarks("bmJobRes").Range _
.InsertBefore TextBox5
.Bookmarks("bmJobR").Range _
.InsertBefore TextBox6
.Bookmarks("bmBen").Range _
.InsertBefore TextBox7
.Bookmarks("bmTag").Range _
.InsertBefore TextBox8
End With
UserForm1.Hide
Selection.WholeStory
Selection.Fields.Update
Selection.Collapse Direction:=wdCollapseEnd
End Sub
Any help would be appreciated.
Try something like this with array and loop:
(see some comments inside the code below)
'let's create temporary array
Dim tmpArray As Variant
tmpArray = Split(TextBox3, " ")
Dim i As Integer
For i = 1 To UBound(tmpArray)
'we will load values to first column in first table in yur document
ActiveDocument.Tables(1).Cell(i, 1).Range = tmpArray(i - 1)
'here do your stuff with excel- load what you need
'ActiveDocument.Tables(1).Cell(i, 2).Range = something from excel
Next i
I need to create a macro to print two sheets and include a custom footer that references several of the cells.
I have tried so many combinations, but I don't know what I am doing wrong. I get the error Object does not support this property or method.
Sub PrintSummarySheet()
' PrintSummarySheet Macro
Sheets("Project Data Input").Select
With ActiveSheet.PageSetup
.CenterFooter = .Range("C6").Text And .Range("F2").Text _
And .Range("F4").Text And .Range("F5").Text
End With
Sheets(Array("Project Data Input", "Project Estimate Summary")).Select
Sheets("Project Data Input").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("INSTRUCTIONS").Select
Sheets("Project Data Input").Select
End Sub
You are using With ActiveSheet.PageSetup but on the next line you are trying to refer to the Worksheet and not the PageSetup by doing .Range(...).
You need to replace .Range(...) by ActiveSheet.Range(...).
The Run-time error 13 Type mismatch occurs because you are using And to concatenate text instead of the concatenation operator &
.Range("C6").Text And .Range("F2").Text _
And .Range("F4").Text And .Range("F5").Text
Should be:
.Range("C6").Text & .Range("F2").Text & _
.Range("F4").Text & .Range("F5").Text
I have a document with comments on a long interview transcript. I found a Macro on SO that let's me export those comments with the highlighted text. This is awesome but the output is terribly dull (plain text).
I need to know if and how to apply bold, italic and insert newlines. I have looked for like an hours now and because my VBA is terrible I have no reference for where to look other than keyword searches on "marco output formatting"
Does someone know how to take the below script and font changes to parts of the text?
Sub ExportComments()
Dim s As String
Dim cmt As Word.Comment
Dim doc As Word.Document
For Each cmt In ActiveDocument.Comments
s = s & "Text: " & cmt.Scope.FormattedText & " -> "
s = s & "Comments: " & cmt.Initial & cmt.Index & ":" & cmt.Range.Text & vbCr
Next
Set doc = Documents.Add
doc.Range.Text = s
End Sub
Maybe I can do it with HTML interpreted by Word?
I'm assuming that the formatting you want included is already within the comment text, and that you are just looking for a way to get that into your final document. Here is a modified version of your script that will do that (with one caveat, listed below):
Sub ExportComments()
Dim cmt As Comment
Dim newdoc As Document
Dim currDoc As Document
Set currDoc = ActiveDocument
Set newdoc = Documents.Add
currDoc.Activate
For Each cmt In currDoc.Comments
With newdoc.Content
cmt.Scope.Copy
.InsertAfter "Text: "
.Collapse wdCollapseEnd
.Paste
.InsertAfter " - > "
cmt.Range.Copy
.InsertAfter "Comments: " & cmt.Initial & cmt.Index & ":"
.Collapse wdCollapseEnd
.Paste
.InsertParagraphAfter
End With
Next
End Sub
The difference here is that I'm using Copy and Paste rather than generating text strings.
Caveat: As the macro is written right now, any character formatting from the Scope (the text that appears next to Text in your file) will be applied to the arrow and the initials as well. This is pretty easy to fix with a search and replace, so I didn't incorporate it into the script.
I am trying to insert two fields in a page header. I am able to insert them at the current selection (see code below), but I would prefer not having to select the page header before inserting the fields. Can this be done?
Sub insertFields()
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="DOCPROPERTY LastSavedTime ", PreserveFormatting:=True
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="FileName", PreserveFormatting:=True
End Sub
If you specify the section of the document to place the field in as well as the type of header (wdHeaderFooterPrimary, wdHeaderFooterFirstPage or wdHeaderFooterEvenPages) you can use this code:
Dim myRange As Range
Set myRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
ActiveDocument.Fields.Add Range:=myRange, Type:=wdFieldEmpty, Text:="DOCPROPERTY LastSavedTime ", PreserveFormatting:=True
Additional Information in response to comment
You can use the Collapse method, which places the insertion point at the start or end position of a range, to insert multiple fields within the header. Add appropriate additional code to insert spaces, formatting or carriage returns:
myRange.Collapse wdCollapseEnd
ActiveDocument.Fields.Add Range:=myRange, Type:=wdFieldEmpty, Text:="FileName", PreserveFormatting:=True