I have this ridiculous problem on ms-word 2007. I have most of my macro working as intended but the orientation can't seem to stay in place. I set it to landscape using VBA but it will always go back to portrait. If I step into the code right after this line the document IS in landscape but as soon as I click even once only in the document it goes back to portrait.
Do you guys have an idea why this happens ? I can't seem to find anyone having this bug on Google.
Option Explicit
Sub créer_rapport()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = New Word.Application
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(Range("path_fichier").Value)
wdApp.Selection.WholeStory
wdApp.Selection.Font.Name = "Courier New"
wdApp.Selection.Font.Size = 7
wdDoc.PageSetup.Orientation = wdOrientLandscape
wdDoc.PageSetup.PaperSize = wdPaperLegal
wdDoc.SaveAs ActiveWorkbook.Path & "\test2", wdFormatXMLDocument
Do While wdApp.Selection.Find.Execute("Merge")
wdApp.Selection.MoveUp wdLine, 1
wdApp.Selection.InsertBreak wdPageBreak
wdApp.Selection.MoveDown wdLine, 2
Loop
With wdDoc
.SaveAs (ActiveWorkbook.Path & "\test")
.Close (True)
End With
wdApp.Quit False
End Sub
This is all there is to my macro (for now).
(Oh and you can highlight bad style, this is the first time I do VBA macros for Word (I do them all the time in Excel))
Thanks !
Instead of:
wdDoc.PageSetup.Orientation = wdOrientLandscape
Try this:
Selection.PageSetup.Orientation = wdOrientLandscape
Related
I am trying to come up with a better way to do the following code. it works as is but due to the issues with windows clipboard memory leaks it's not reliable and not very fast. If possible I want to assign the image being copied from word.application directly into an array or at least be able to bypass the clipboard been trying for days.
Dim ShapeName As String
Const BarcodeWidth As Integer = 175
Dim ws As Worksheet, WdApp
Set ws = ActiveSheet
Set WdApp = CreateObject("Word.Application")
Do Until ActiveSheet.Cells(RowLoc, 1) = "End of File"
ShapeName = ActiveSheet.Cells(RowLoc, 1)
With WdApp.Documents.Add
.PageSetup.RightMargin = .PageSetup.PageWidth - .PageSetup.LeftMargin - BarcodeWidth
.Fields.Add(Range:=.Range, Type:=-1, Text:="DISPLAYBARCODE " & ShapeName & " CODE128 \d \t", PreserveFormatting:=False).Copy
End With
Sheets("Barcode").Cells(RowLoc, 5).Select 'selects the location where the bar code will be pasted
ws.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False 'Pastes the bar code at the current selection
RowLoc = RowLoc + 1
Selection.name = ShapeName
Application.CutCopyMode = False
Loop
WdApp.Quit SaveChanges:=False
Set WdApp = Nothing
End Sub
I never found a way to store the images in excel however I figured out the best way achieve what I was going for is to create code that preps the data in the format I need then mail merge the result into a template creates the shipping labels I am going for.
I'm making an Add-in for PowerPoint 2013. My goal is to convert all equations that I find on slides to normal text, to change the font of those equations.
Because it won't let me change font while they are equations. I managed to find the equations, by iterating through text ranges and finding font name, they use "Cambria Math". So my question is how can programmatically change equations to normal text, Like the button in equation tools does? And it seems for some reason they removed "record macro" from PowerPoint, so I couldn't get help from that.
I tried recording macro in word and doing the same thing, and i got: Selection.OMaths(1).ConvertToMathText, but it doesn't seem to be OMaths in PowerPoint.
Dim Application As PowerPoint.Application = New PowerPoint.Application
Dim Presentation As PowerPoint.Presentation = Application.ActivePresentation
Dim Windows As PowerPoint.DocumentWindows = Application.Windows
For Each Slide As PowerPoint.Slide In Presentation.Slides
For Each Shape As PowerPoint.Shape In Slide.Shapes
For Each Paragraph As PowerPoint.TextRange In Shape.TextFrame.TextRange
For Each Line As PowerPoint.TextRange In Paragraph.Lines
If Line.Font.Name = "Cambria Math" Then
With Line.Font
.Name = "Calibri"
.Bold = True
End With
ElseIf Line.Font.Name = "Calibri" Then
With Line.Font
.Name = "Palatino"
End With
End If
Next Line
Next Paragraph
Next Shape
Next Slide
End Sub
Other text here is changed normally, but equations the ones with "Math Cambria" font, are unchanged.
I also tried to get selection, then something with OMaths, like in Word Vsto, but, it seems OMaths is not part of the PowerPoint. This next code is actually supposed to change it to equation, but i guess if it worked, could have find a way to reverse it.
For Each Window As PowerPoint.DocumentWindow In Windows
Selection.OMaths(1).ConvertToMathText
Next Window
I got it to work with PowerPoint 2016 in VBA. I didn't have "Calibri" in my list of fonts, so I changed it to "Calibri (Body)" and it works. It may be the same issue you're having with the .NET VSTO Addin. If I have time, I'll build a example of the VSTO Addin and post the results as well.
Video
VBA Code
Public Sub UpdateShapeFont()
On Error GoTo ErrTrap
Dim Application As PowerPoint.Application: Set Application = New PowerPoint.Application
Dim Presentation As PowerPoint.Presentation: Set Presentation = Application.ActivePresentation
Dim Windows As PowerPoint.DocumentWindows: Set Windows = Application.Windows
Dim Slide As PowerPoint.Slide
Dim Shape As PowerPoint.Shape
Dim Paragraph As PowerPoint.TextRange
Dim line As PowerPoint.TextRange
For Each Slide In Presentation.Slides
For Each Shape In Slide.Shapes
For Each Paragraph In Shape.TextFrame.TextRange
For Each line In Paragraph.Lines
Select Case line.Font.Name
Case "Cambria Math"
With line.Font
.Name = "Calibri (Body)" 'check if the font exists in your list of fonts; it did not work for "Calibri"
.Bold = True
End With
Case "Calibri"
With line.Font
.Name = "Palatino"
End With
End Select
Next line
Next Paragraph
Next Shape
Next Slide
ExitProcedure:
On Error Resume Next
Exit Sub
ErrTrap:
Select Case Err.number
Case Else
Debug.Print "Error #: " & Err.number & " |Error Description: " & Err.description
End Select
Resume ExitProcedure
Resume 'for debugging
End Sub
I am looking to create a via script in excel that will replace a text holder in a word doc with some text from excel.
I can get the via script to open the word doc, and then save the doc under a new name. however it will not execute the replace text part :(
Private Sub CommandButton1_Click()
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open("temp.docx")
With wdDoc.Content.Find
.ClearFormatting
.Text = "<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
wdDoc.SaveAs2 Filename:=("temp2.docx")
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
I have tried doing a search in here but can't see where I am going wrong :(
currently it opens the word doc and saves it under a new name but does not replace the find and replace the text. Can anyone see where I have gone wrong and show me how to get it right?
When I set up a test for your problem description in Word, by typing <<name>> I see that Word replaces the two angled brackets with special symbols. And it offers the possibility to undo the AutoCorrect causing this.
Querying ASC(Selection.Text) on them gives Chr(171) and Chr(187), which are also double-angled bracket symbols, but using them in Find does not work. Querying AscW() reveals the two symbols are Unicode 8810 and 8811, so they need to be searched differently.
Assuming that's the issue in your case, the following works:
With wdDoc.content.Find
.ClearFormatting
.Text = ChrW(8810) & "name" & ChrW(8811) '"<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
Further to your code - it has other, potentially grave problems (memory leak):
If you do this: wdApp.Visible = False then you need to be absolutely certain to remove Word from memory:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Unlike Excel, Word won't quit automatically when its object goes out of scope (macro ends). It will stay open, which you can see in the Task Manager.
In addition, you need to release the objects in the reverse order in which they were instantiated - wdDoc before wdApp.
Setup some DocVariables in your Word doc and run the code below, from within Excel.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next
objWord.ActiveDocument.variables("BrokerFirstName").Value = Range("BrokerFirstName").Value
objWord.ActiveDocument.variables("BrokerLastName").Value = Range("BrokerLastName").Value
objWord.ActiveDocument.variables("Ryan").Value = Range("Ryan").Value
objWord.ActiveDocument.Fields.Update
'On Error Resume Next
objWord.Visible = True
End Sub
You can use essentially the same process by setting up Bookmarks in Word, and pushing data from fields in Excel to fields (Bookmarks) in Word.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
On Error Resume Next
ActiveDocument.Variables("BrokerFirstName").Value = Range("B1").Value
ActiveDocument.Variables("BrokerLastName").Value = Range("B2").Value
ActiveDocument.Fields.Update
On Error Resume Next
objWord.Visible = True
End Sub
The famouse hope - to have one button for all live cases with caption: "Make it OK!"
Do divide the task on parts:
- Get "... text from excel ..."
- "replace text in word doc ..." with text getted from Excel on previouse step
Do it by two separate procedures for each of tasks,
called from the third procedure united them.
.
I have a large Lotus Notes project, a small part of which uses Word to create PDFs. In one piece, it pastes some text into a new Word document and saves as a PDF, like this:
Set wrdApp = createObject("Word.Application")
wrdApp.visible = True
Set wrdDoc = wrdApp.documents.add()
Set selection=wrdApp.Selection
selection.InsertBefore(doc.body(0))
strSaveFilename = "HelloWorld.pdf"
wrddoc.Saveas strSaveFileName, 17
Call wrddoc.close(0)
Set wrddoc = Nothing
Call wrdapp.quit(0)
Set wrdapp = Nothing
and in another part of the same chunk, it opens a Word document and then saves it as a PDF, like this:
Set MCwrdApp = createObject("Word.Application")
McwrdApp.visible = true
Dim wrdDoc As Variant 'word document
strfilename = "HelloWorld.docx"
Set wrddoc = MCwrdApp.documents.Open(strfilename)
f2 = "HelloWorld.pdf"
wrddoc.ExportAsFixedFormat f2, 17, 0, 1
wrddoc.close(0)
Set wrddoc = Nothing
Call Mcwrdapp.quit(0)
Set McwrdApp = Nothing
The problem I'm having is that since we upgraded to Office 2016, occasionally WINWORD.EXE gets left running and I have to kill it with Task Manager. The last time it happened Word was started in the sub that does the copy/paste. But that's not the question. The question is, are there differences between using .SaveAs and .ExportAsFixedFormat in this scenario? Why would the developer (not me) have used one in one place and the other somewhere else?
Can any one please tell, How to find a specific word in a word document and paste a word near to that using vba code?
I have already opened the document.So i just want to find the word and paste a word near to that. I have done this using movedown and moveright methods to go to that specific word.But it is more dependent on the position of cursor.
Thanks,
Bharathi
I use this in access I don't know if it will work for you.
Dim mWord As Word.Application
Dim mDoc As Word.Document
Dim mRange As Word.Range
Set mDoc = mWord.Documents.Open("YourPath")
mDoc.SaveAs "Where you want to save"
Set mWord = New Word.Application
mWord.Visible = False
DoEvents
Set mRange = mWord.ActiveDocument.Content
mRange.Find.Execute FindText:=TextToFind1, ReplaceWith:=TextToFind1 & TextToReplace1, Replace:=wdReplaceAll
mRange.Find.Execute FindText:="TextToFind2", ReplaceWith:="TextToReplace2", Replace:=wdReplaceAll
Set mRange = Nothing
mDoc.Save
'Display
mWord.Visible = True
Shell "Explorer.exe /n,/e," & "DirectoryToOpen", vbNormalFocus
Good luck