I want to loop through my word document removing all backgroundcolors on each word. This is my code so far but it is not working - I get the following error message "Argument not optional" and ".Item" is highlighted:
Sub ResetColor()
Dim doc As Document
Set doc = ActiveDocument
Set eword = doc.Range.Words.Item
For i = 1 To doc.Range.Words
eword.Shading.Texture = wdTextureNone
eword.Shading.ForegroundPatternColor = wdColorAutomatic
eword.Shading.BackgroundPatternColor = wdColorAutomatic
Next
End Sub
Try this:
Sub ResetColor()
Dim doc As Document
Set doc = ActiveDocument
For Each eword In doc.Range.Words
eword.Shading.Texture = wdTextureNone
eword.Shading.ForegroundPatternColor = wdColorAutomatic
eword.Shading.BackgroundPatternColor = wdColorAutomatic
Next
End Sub
Related
I have a problem when using VBA for column operation.
I want to select an area in a Word document that contains several paragraphs, and then I want to split them from one column into two.
My VBA code is as follows:
Public Sub testSplitColumn()
Dim targetDoc As Document
Dim sourceFileName As String
sourceFileName = "file path"
Set targetDoc = Documents.Open(sourceFileName, , True)
targetDoc.Paragraphs(503).range.Select
'Splitting column on word
With targetDoc.Paragraphs(503).range.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
It runs, but the result is wrong.
It is columnizing the paragraphs in the entire document, not just the selected paragraphs in the code.
I got a macro code that can achieve the correct effect through the method of word macro recording:
Sub split()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
With Selection.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
But it's no different from mine.
How can I fix my VBA code?
As #JerryJeremiah said: you need section breaks before and after your selection.
When recording a macro - they will be inserted as well.
I would create a generic sub to insert the section breaks:
Public Sub test_splitTo2Columns()
'your original code
Dim targetDoc As Document
Dim sourceFileName As String
sourceFileName = "file path"
Set targetDoc = Documents.Open(sourceFileName, , True)
'calling the generic function to test with specific paragraph
splitTo2Columns targetDoc.Paragraphs(503).Range
'this will work too - splitting the selected range
splitTo2Columns ActiveDocument.Selection.Range
End Sub
Public Sub splitTo2Columns(rg As Range, Optional fSplitWholeParagraphs As Boolean = True)
Dim rgToSplit As Range
Set rgToSplit = rg.Duplicate
If fSplitWholeParagraphs = True Then
'in case rg = selection and selection is only a single character
rgToSplit.Start = rgToSplit.Paragraphs.First.Range.Start
rgToSplit.End = rgToSplit.Paragraphs.Last.Range.End
End If
insertSectionBreakContinous rgToSplit, wdCollapseStart
insertSectionBreakContinous rgToSplit, wdCollapseEnd
rgToSplit.Start = rgToSplit.Start + 1 'move behind first section break
With rg.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
Private Sub insertSectionBreakContinous(rg As Range, startEnd As WdCollapseDirection)
Dim rgBreak As Range
Set rgBreak = rg.Duplicate
With rgBreak
.Collapse startEnd
.InsertBreak wdSectionBreakContinuous
End With
End Sub
My intention is to use a VBA code to extract the comments from a PowerPoint document and paste the information in a table in Word.
I started to build a code that works on Word and I tried to adapt in to work with PowerPoint. Unfortunately I run in some errors like Error 07 memory issue, while the code works perfectly to extract comments form a word document...
I am lost and do not know what to do...
Is there an expert who could help me verifying the code? I made notes in the code to make it easy to read.
PS: In PowerPoint VBA Editor, I did enabled the reference for Word.
Sub Tansfer_PPT_comments_in_WordDoc()
Dim n As Long
Dim nCount As Long
Dim ppt As Presentation
Dim wdapp As Word.Application
Dim wddoc As Word.Document
Dim wdtable As Table
Set ppt = ActivePresentation
nCount = ActivePresentation.Comments.Count
'Open a Word document
On Error Resume Next
Set wdapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdapp = CreateObject("Word.Application")
End If
On Error GoTo 0
'Create word page with landscape orientation
Set wddoc = Documents.Add
wddoc.PageSetup.Orientation = wdOrientLandscape
'Insert a 5-column table
With wddoc
.Content = ""
Set wdtable = .Tables.Add _
(Range:=Selection.Range, _
Numrows:=nCount + 1, _
NumColumns:=5)
End With
'DOCUMENT FORMATTING
'Define Normal and Header style
With wddoc.Styles(wdStyleNormal)
.Font.Name = "Arial"
.Font.Size = 10
.ParagraphFormat.LeftIndent = 0
.ParagraphFormat.SpaceAfter = 6
End With
With wddoc.Styles(wdStyleHeader)
.Font.Size = 8
.ParagraphFormat.SpaceAfter = 0
End With
'Format table
With wdtable
.Range.Style = wdStyleNormal
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Columns(1).PreferredWidth = 2
.Columns(2).PreferredWidth = 20
.Columns(3).PreferredWidth = 40
.Columns(4).PreferredWidth = 8
.Columns(5).PreferredWidth = 40
.Rows(1).HeadingFormat = True
.Columns(1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Rows(1).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.ColorIndex = wdDarkBlue
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = -603937025
End With
'Add table borders
With wdtable.Borders
.InsideLineStyle = Options.DefaultBorderLineStyle
.InsideLineWidth = Options.DefaultBorderLineWidth
.InsideColor = Options.DefaultBorderColor
.OutsideLineStyle = Options.DefaultBorderLineStyle
.OutsideLineWidth = Options.DefaultBorderLineWidth
.OutsideColor = Options.DefaultBorderColor
End With
'DOCUMENT CONTENT
'Define table headings names
With wdtable.Rows(1)
.Range.Font.Bold = True
.Cells(1).Range.Text = "Page"
.Cells(2).Range.Text = "Comment scope"
.Cells(3).Range.Text = "Comment text"
.Cells(4).Range.Text = "Author"
.Cells(5).Range.Text = "Parexel response"
End With
'Insert information from the comments in ppt into the wddoc table
For n = 1 To nCount
With wdtable.Rows(n + 1)
'Page number
.Cells(1).Range.Text = _
ppt.Comments(n).Scope.Information(wdActiveEndPageNumber)
'The text marked by the comment
.Cells(2).Range.Text = ppt.Comments(n).Scope
'The comment itself
.Cells(3).Range.Text = ppt.Comments(n).Range.Text
'The comment author
.Cells(4).Range.Text = ppt.Comments(n).Author
End With
Next n
ScreenUpdating = True
Application.ScreenRefresh
wddoc.Activate
Set ppt = Nothing
Set wddoc = Nothing
Set wdtable = Nothing
End Sub
Your code will fail at:
ActivePresentation.Comments.Count
since Comments are not a Presentation property. And, once you get over that hurdle, your code will fail at:
.Scope.Information(wdActiveEndPageNumber)
since PowerPoint Comments don't have a scope property and, even if they did, '.Information(wdActiveEndPageNumber)' refers to a Word constant, not a PowerPoint one.
You can't simply take VBA methods, properties, and constants that apply to one application and assume they apply to another in the same way. You need to develop your PowerPoint code using valid PowerPoint methods, properties, and constants.
For some code to get you started on the right tack, see: http://www.pptfaq.com/FAQ00900_Export_comments_to_a_text_file_-PowerPoint_2002_and_later-.htm
I have the code below without using Selection.
Sub Format paragraph()
Dim wdDoc As Document
With wdDoc.Range.Find
.Font.Size = 12
.Text = "?"
.Execute
End With
End Sub
When the character with font size = 12 is found, how can I change the format of the current paragraph? for example:
wdDoc.Paragraph(current).Font.Size = 14
wdDoc.Paragraph(current).Font.Color = wdBlue
Thanks for any help.
The trick is to work with a specific Range object, which can be used to access its "parent" paragraph. When Find.Execute is successful, the Range being searched contains the found item (same as the selection jumps to the found item). For example:
Sub Format paragraph()
Dim rng as Range, para as Paragraph
Dim wdDoc As Document
Set wdDoc = ActiveDocument. 'Missing in code in question...
Set rng = wdDoc.Content 'Content returns the Range
With rng.Find
.Font.Size = 12
.Text = "?"
If .Execute = True Then
Set para = rng.Paragraphs(1)
para.Font.Size = 14
para.Font.Color = wdBlue
End If
End With
End Sub
I have a word document (report) and in that document, I'm importing many text files with fields like this:
{INCLUDETEXT "C:\\PATH\\TOXMLFILES\\Request.xml" \*CHARFORMAT}
Also I'm updating all those fields with a macro on opening the document...
Sub AutoOpen()
With Options
.UpdateFieldsAtPrint = True
.UpdateLinksAtPrint = True
End With
ActiveDocument.Fields.Update
End Sub
Now I need to highlight the text of those imported XMLs (in the IncludeText fields) between <faultstring></faultstring> tags
Here is code I got here on stackoverflow for highlighting text (making it bold)
Sub BoldBetweenQuotes()
' base for a quotes finding macro
Dim blnSearchAgain As Boolean
Dim blnFindStart As Boolean
Dim blnFindEnd As Boolean
Dim rngFind As word.Range
Dim rngFindStart As word.Range
Dim rngFindEnd As word.Range
Set rngFind = ActiveDocument.content
Set rngFindStart = rngFind.Duplicate
Do
' set up find of first of quote pair
With rngFindStart.Find
.ClearFormatting
.Text = "<faultstring>"
.Replacement.Text = ""
.Forward = True
.wrap = wdFindStop
blnFindStart = .Execute
End With
If blnFindStart Then
rngFindStart.Collapse wdCollapseEnd
Set rngFindEnd = rngFindStart.Duplicate
rngFindEnd.Find.Text = "</faultstring>"
blnFindEnd = rngFindEnd.Find.Execute
If blnFindEnd Then
rngFindStart.End = rngFindEnd.Start
' make it bold
rngFindStart.Font.Bold = True
rngFindStart.Start = rngFindEnd.End
rngFindStart.End = rngFind.End
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain = True
End Sub
Problem is, when I run the macro in my Word document (with the IncludeText fields) it keeps cycling and bolding just the first appearance of text between faultstring tags. When I run it in a new Word document with some random text and faultrstring tags it works well...
EDIT: It turns out the problem is due to the faultstring tags being inside the IncludeText fields. I need to turn the fields into static text after opening the document and updating the fields. How can I do that?
In order to convert dynamic field content to static text using Word's object model (such as VBA) the Fields.Unlink method is required. For the entire document:
ActiveDocument.Fields.Unlink
This is also possible for any given Range; to remove the fields in the last paragraph, for example:
ActiveDocument.Paragraphs.Last.Range.Fields.Unlink
In order to unlink only a certain type of field, loop the Fields collection, test the Field.Type and unlink accordingly. For example, for IncludeText:
Sub DeleteIncludeTextFields()
Dim doc As word.Document
Set doc = ActiveDocument
Debug.Print DeleteFieldType(wdFieldIncludeText, doc)
End Sub
Function DeleteFieldType(fldType As word.WdFieldType, doc As word.Document) _
As Long
Dim fld As word.Field
Dim counter As Long
counter = 0
For Each fld In doc.Fields
If fld.Type = wdFieldIncludeText Then
fld.Unlink
counter = counter + 1
End If
Next
DeleteFieldType = counter
End Function
Assuming you want to do this for all the fields in your document, after updating it:
Sub AutoOpen()
With Options
.UpdateFieldsAtPrint = True
.UpdateLinksAtPrint = True
End With
ActiveDocument.Fields.Update
ActiveDocument.Fields.Unlink
End Sub
I am exporting an excel table into word using VBA. The word document has one bookmark. The code is such that first it writes the TYPE as the heading and then write all the description under that TYPE. I want the headings to be bold and formatted. I have the following code but it does not work. If anyone could suggest something.
If Dir(strPath & "\" & strFileName) <> "" Then
'Word Document open
On Error Resume Next
Set objWDApp = GetObject(, "Word.Application")
If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")
With objWDApp
.Visible = True 'Or True, if Word is to be indicated
.Documents.Open (strPath & "\" & strFileName)
Set objRng = objWDApp.ActiveDocument.Bookmarks("Bookmark").Range
.Styles.Add ("Heading")
.Styles.Add ("Text")
With .Styles("Heading").Font
.Name = "Arial"
.Size = 12
.Bold = True
.Underline = True
End With
With .Styles("Text").Font
.Name = "Arial"
.Size = 10
.Bold = False
.Underline = False
End With
End With
On Error GoTo 0
i = Start_Cell
idx(1) = i
n = 2
Do ' Search for first empty cell in the table
i = i + 1
If i > Start_Cell + 1 And Cells(i, QB_Type).Value = Cells(i - 1, QB_Type) Then GoTo Loop1
idx(n) = i
n = n + 1
Loop1:
Loop Until IsEmpty(Cells(i + 1, QB_Type).Value)
idxEnd = i
idx(n) = 9999
i = Start_Cell
n = 1
Do
If i = idx(n) Then
strTMP = vbNewLine & vbNewLine & Cells(idx(n), QB_Type).Value & vbNewLine
With objWDApp
'.Selection.Font.Bold = True 'Type Bold (Doesnt Functions!?)
.Selection.Styles ("Heading") 'I tried this as well but not functioning...gives an error here that object does not support this property
WriteToWord objRng, strTMP 'Text written
End With
n = n + 1
End If
strTMP = vbNewLine & Cells(i, QB_Description).Value & vbNewLine
With objWDApp
' .Selection.Font.Bold = False 'Description Not bold (Not functioning!?)
.Selection.Styles("Text") 'This is also not functioning
WriteToWord objRng, strTMP 'Text written
End With
i = i + 1 'Arbeitspunktzähler erhöhen
Loop Until i > idxEnd
Public Sub WriteToWord(objRng, text)
With objRng
.InsertAfter text
End With
End Sub
Try .Selection.Style.Name = "Heading" from here
Edit 2
The following code works as expected. You will need to modify it to fit your needs. I successfully added and then bolded text to an existing word document.
Option Explicit
Public Sub Test()
' Add a reference to Microsoft Word x.0 Object Library for early binding and syntax support
Dim w As Word.Application
If (w Is Nothing) Then Set w = New Word.Application
Dim item As Word.Document, doc As Word.Document
' If the document is already open, just get a reference to it
For Each item In w.Documents
If (item.FullName = "C:\Path\To\Test.docx") Then
Set doc = item
Exit For
End If
Next
' Else, open the document
If (doc Is Nothing) Then Set doc = w.Documents.Open("C:\Path\To\Test.docx")
' Force change Word's default read-only/protected view
doc.ActiveWindow.View = wdNormalView
' Delete the preexisting style to avoid an error of duplicate entry next time this is run
' Could also check if the style exists by iterating through all styles. Whichever method works for you
doc.Styles.item("MyStyle").Delete
doc.Styles.Add "MyStyle"
With doc.Styles("MyStyle").Font
.Name = "Arial"
.Size = 12
.Bold = True
.Underline = wdUnderlineSingle
End With
' Do your logic to put text where you need it
doc.Range.InsertAfter "This is another Heading"
' Now find that same text you just added to the document, and bold it.
With doc.Content.Find
.Text = "This is another Heading"
.Execute
If (.Found) Then .Parent.Bold = True
End With
' Make sure to dispose of the objects. This can cause issues when the macro gets out mid way, causing a file lock on the document
doc.Close
Set doc = Nothing
w.Quit
Set w = Nothing
End Sub
By adding a reference to the object library, you can get intellisense support and compilation errors. It would help you determine earlier in development that Styles is not a valid property off the Word.Application object.