I want to override the Word 2010 standard quick styles with my own. But I get an error as shown below:
With tempDoc.Styles(wdStyleNormal) '// <-- here is the error
.Font.Name = "Arial"
.Font.Size = 10
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.ParagraphFormat.LineSpacing = 12
End With
You can find the whole code here: http://qranberry.com/stackoverflow/code.bas
You need to set the document like below .. Code tested and working fine in my system
Sub test()
Dim tempDoc As Document
Set tempDoc = ActiveDocument
With tempDoc.Styles(wdStyleNormal) ' or u can use activedocument instead of tempdoc
.Font.Name = "Arial"
.Font.Size = 30
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.ParagraphFormat.LineSpacing = 12
End With
End Sub
Related
So I'm using the following code to add a text box to the header of several slides:
Set myDocument = ActivePresentation.Slides.Range(Array(4, 5, 6))
Set newTextBox = myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
260, Top:=30, Width:=541.44, Height:=43.218)
With newTextBox.TextFrame.TextRange
.Text = "Test Text"
.Font.Size = 17
.Font.Name = "Arial"
End With
When I run this code I get an automation error and it doesn't work. If I do it on a single slide it does work. Does anyone know why? What I'm attempting to do is add headers to specific slides. So I will be using the same method to add different headers to other slides as well.
You can go through all the slides with numbers from the array you set:
Sub slideTextBoxes()
For Each myDocument In ActivePresentation.Slides.Range(Array(4, 5, 6))
Set newTextBox = myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
260, Top:=30, Width:=541.44, Height:=43.218)
With newTextBox.TextFrame.TextRange
.Text = "Test Text"
.Font.Size = 17
.Font.Name = "Arial"
End With
Next
End Sub
Slides don't have headers. But here is code that will work:
Sub AddTextBoxes()
Dim oSlide As Slide
Dim oShape As Shape
For Each oSlide In ActivePresentation.Slides
If oSlide.SlideIndex = 4 Or oSlide.SlideIndex = 5 Or oSlide.SlideIndex = 6 Then
Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=260, Top:=30, Width:=541.44, Height:=43.218)
With oShape.TextFrame.TextRange
.Text = "Test Text"
.Font.Size = 17
.Font.Name = "Arial"
End With
End If
Next oSlide
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 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.
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