Macro to Copy Content from Excel and paste in MS Word - vba

I have an idea for a report generation macro from Excel to Word.
The report format in excel is as below .
The report in word
There is an existing code as below to copy and paste in word . But is there a way to format it as in the above screenshot?
Sub TestingMacAndWin()
Dim appWD As Object
Dim wddoc As Object
On Error Resume Next
Set appWD = GetObject(, "Word.application") 'gives error 429 if Word is not open
If Err = 429 Then
Set appWD = CreateObject("Word.application") 'creates a Word application
Err.Clear
End If
Set wddoc = appWD.Documents.Add
appWD.Visible = True
With appWD.ActiveDocument.PageSetup
.TopMargin = appWD.InchesToPoints(0.3)
.BottomMargin = appWD.InchesToPoints(0.3)
.LeftMargin = appWD.InchesToPoints(0.3)
.RightMargin = appWD.InchesToPoints(0.3)
End With
Sheets("Sheet1").Range("A1:D2").CopyPicture xlScreen
appWD.Selection.Paste
appWD.Activate
End Sub
source : http://www.rondebruin.nl/mac/mac030.htm

Paste your data in. Stop your Macro (stop command will do that), then record your formatting (Alt + T, M, R). Go get the recorded macro, and paste it into your macro, fixing the object you are working on (eg .ActiveDocument to AppWD.ActiveDocument though you probably don't have to do).
COM have changed over the years, and is now recommended to GetObject the Document object, not the Application Object. Among other minor things it elininates reference counting problems on the Application object, this where the application doen't exit when closed.

Related

Excel to Word (Text won't Justify) VBA

So to summarize things, I am creating a word document and pasting an excel table into the Word document. The only problem I'm facing now is that the texts in the Word document is aligned left but I want it Justified. However, no matter what I do I can't seem to get it to justify unless I manually do it on Word.
Please find below my code less all the non-relevant stuff. I'm a VBA noob so how I've been doing it is just copy pasting and trying to adapt it to what I need. So far everything works except the justifying part.
Dim obj As Object
Set obj = GetObject(, "Word.Application")
If obj Is Nothing Then
Set obj = CreateObject("Word.Application")
End If
obj.Visible = True
Set objDoc = obj.Documents.Add
a = Sheets("Print").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Print").Range("A1:F" & a).Copy
objDoc.Range.PasteExcelTable False, False, True
objDoc.Activate
objDoc.Tables(1).AutoFitBehavior wdAutoFitContent
Application.CutCopyMode = False
On Error GoTo 0
With objDoc.Tables(1)
.PreferredWidth = 505
End With
With objDoc.PageSetup
.TopMargin = Application.InchesToPoints(0.71)
.BottomMargin = Application.InchesToPoints(0.71)
.LeftMargin = Application.InchesToPoints(0.71)
.RightMargin = Application.InchesToPoints(0.71)
End With
With objDoc
.Range.ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
'set paragraph spacing after to 0
.Range.ParagraphFormat.SpaceAfter = 10
.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
End With
Sheets("DCN Inputs").Select
End Sub
The problem is that you use the Word enumeration value wdAlignParagraphJustify but you don't have a reference to the Word object library. Excel VBA doesn't recognize this member of the Word object model without a specific reference (Tools/References).
If you want to use late-binding, as you have otherwise throughout your code, then you need to substitute the numerical value of the enumeration, which in this case is 3. For example:
objDoc.Range.PasteExcelTable False, False, True
objDoc.Activate
Set objTable = objDoc.Tables(1)
With objTable
.AutoFitBehavior wdAutoFitContent
.PreferredWidth = 505
.Range.ParagraphFormat.Alignment = 3 'wdAlignParagraphJustify
End With
Application.CutCopyMode = False

Error 4605 on opening Word document when another document is already open

So I have this problem on the error handler when I want to open a specific word document.
What the program does so far when I start it is: First time start is fine. Then when I run again the program keeps loading until I manually close Word. And after that Word gives me and option to access the file in read-only mode.
I've searched on forums and MSDN for a few hours now and can't find a solution.
Also it keeps giving me
error code 4605
when I run the code a second time.
Code:
Sub OpenWord()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
WordApp.DisplayAlerts = wdAlertsNone
On Error GoTo ErrorHandler:
WordApp.Documents.Open ("C:\Users\mvandalen\Desktop\Test.docx")
WordApp.Visible = True
Exit Sub
''just for testing
VariableCheese = 5 + 5
ErrorHandler:
WordApp.Documents.Close <<< Here it gives error 4605
WordApp.Quit
Resume Next
End Sub
final edit:
Thanks to #Brett I've found a solution. I copied his code and removed the following lines (tagged with >>>):
Sub final()
Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
>>>>If TestDoc Is Nothing Then
Set Wd = GetObject(, "Word.Application")
If Wd Is Nothing Then
Set Wd = CreateObject("Word.Application")
If Wd Is Nothing Then
MsgBox "Failed to start Word!", vbCritical
Exit Sub
End If
>>>>f = True
**Else** Added line
**MsgBox "Failed to start Word!", vbCritical** Added line
End If
>>>Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
>>>If TestDoc Is Nothing Then
>>>MsgBox "Failed to open help document!", vbCritical
>>>If f Then
>>>Wd.Quit
>>>End If
>>>Exit Sub
End If
Wd.Visible = True
>>>Else
>>>With WordDoc.Parent
>>>.Visible = True
>>>.Activate
>>>End With
>>>End If
End sub
This code opens the file once and then not again until you close it.
But for some reason this line is required Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx"). If not the Word document will become read-only.
I would start by going to File > Options > General and see if there is a check mark in the box: Open e-mail attachments and other uneditable files in reading view. If there is, remove it.
Source: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_windows8-mso_2013_release/run-time-error-4605-in-word-2013-no-information/1ca02c04-5cea-484e-bd23-f4d18183c1b2
That said, My feel is that you are trying to close a document that has already been closed (or not active) or that there is no error.
To remedy this check there is an an error:
If Err <> 0 Then
''Insert your error handling code here
Err.Clear
Resume Next
See: https://support.microsoft.com/en-au/help/813983/you-receive-run-time-error-4248-4605-or-5941-when-you-try-to-change-pr
Alternatively, the problem is that you are not checking to see if the document is already opened. This likely results in a continuous loop. I suggest using code similar to the example below to detect if the document is already opened.
Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
If TestDoc Is Nothing Then
Set Wd = GetObject(, "Word.Application")
If Wd Is Nothing Then
Set Wd = CreateObject("Word.Application")
If Wd Is Nothing Then
MsgBox "Failed to start Word!", vbCritical
Exit Sub
End If
f = True
End If
Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
If TestDoc Is Nothing Then
MsgBox "Failed to open help document!", vbCritical
If f Then
Wd.Quit
End If
Exit Sub
End If
Wd.Visible = True
Else
With WordDoc.Parent
.Visible = True
.Activate
End With
End If
This code will activate the document if it is already opened.
Source: https://social.msdn.microsoft.com/Forums/en-US/29265e5f-8df9-4cab-8984-1afb9b110d2f/in-excel-use-vba-to-check-if-a-word-document-is-open?forum=isvvba
Based on your new information another possible cause is that Visual Basic has established a reference to Word because of a line of code that calls a Word object, method, or property without qualifying the element with a Word object variable. Visual Basic does not release this reference until you end the program. This errant reference interferes with automation code when the code is run more than one time. To fix this, change the code so each call to a Word object, method, or property is qualified with the appropriate object variable.
The nearest to explain this is an Excel article: https://support.microsoft.com/en-hk/help/178510/excel-automation-fails-second-time-code-runs
To help you more I would need to know:
What version of Word you are using.
Are you using MacOS or Windows.
What are your macro security settings?
If you kill all Word process does the error still show?
Is the document is ready only or otherwise protected?
If you open the document and it's in the active window when you go to the Developer tab and run your macro does the error still occur?
Given we know the document keeps getting protected try removing protection by going into the trust center and ensuring Word 2003/7 Binary Documents and Templates is not ticked.
On looking at your code more closely, I think the problem is that you don't release the Word objects. Since this code is running from within Excel, those objects are being held in memory, not being released when the macro ends. And Word notoriously has problems with trying to open a document that is still open - because you have an object to it in memory holding it open.
See my changes to your code, below - the Set [variable] = Nothing lines.
(Please note that you mix the variable names "TestDoc" and "WordDoc" in your code sample - I just copied it - so the code, as it stands, cannot run correctly.)
Set TestDoc = GetObject("C:\Users\mvandalen\Desktop\Test.docx")
If TestDoc Is Nothing Then
Set Wd = GetObject(, "Word.Application")
If Wd Is Nothing Then
Set Wd = CreateObject("Word.Application")
If Wd Is Nothing Then
MsgBox "Failed to start Word!", vbCritical
Exit Sub
End If
f = True
End If
Set TestDoc = Wd.Documents.Open("C:\Users\mvandalen\Desktop\Test.docx")
If WordDoc Is Nothing Then
MsgBox "Failed to open help document!", vbCritical
If f Then
Wd.Quit
Set Wd = Nothing
End If
Exit Sub
End If
Wd.Visible = True
Else
With WordDoc.Parent
.Visible = True
.Activate
End With
End If
Set WordDoc = Nothing
Set Wd = Nothing
Try the following code. It:
• starts Word if it's not already running.
• opens the document if it's not already open.
• saves & closes the document after editing if it opened it.
• quits Word if it started it.
You can, of course, omit the document close and app quit code if you want to keep the document open. Depending on whether you want to prevent edits to the file being saved, you may want to set ReadOnly:=True, also.
Sub OpenWord()
Dim WdApp As Word.Application, WdDoc As Word.Document
Dim bQuit As Boolean, bClose As Boolean
Const StrFlNm As String = "C:\Users\mvandalen\Desktop\Test.docx"
If Dir(StrFlNm) = "" Then
MsgBox "Cannot find the file:" & vbCr & StrFlNm, vbCritical
Exit Sub
End If
bQuit = False: bClose = True
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If WdApp Is Nothing Then
Set WdApp = CreateObject("Word.Application")
On Error GoTo 0
If WdApp Is Nothing Then
MsgBox "Can't start Word.", vbExclamation
Exit Sub
End If
bQuit = True
End If
On Error GoTo 0
With WdApp
.Visible = True
For Each WdDoc In .Documents
If WdDoc.FullName = StrFlNm Then
bClose = False: Exit For
End If
Next
If WdDoc Is Nothing Then
Set WdDoc = .Documents.Open(Filename:=StrFlNm, ReadOnly:=False, AddToRecentFiles:=False, Visible:=True)
End If
With WdDoc
'Do your document edits here
If bClose = True Then .Close SaveChanges:=True
End With
If bQuit = True Then .Quit
End With
End Sub
you have to carefully handling the possibility of having already running Word session as well as not being able to get a Word session
so you may use a helper function:
Function GetWord(WordApp As Word.Application) As Boolean
On Error Resume Next
Set WordApp = GetObject(, "Word.Application") 'try getting an already running Word instance
If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application") ' if unsuccesful then try creating a new Word instance
GetWord = Not WordApp Is Nothing ' notify the result
End Function
and therefore your main code would be refactored as follows
Option Explicit
Sub OpenWord()
Dim WordApp As Word.Application
If Not GetWord(WordApp) Then 'if unsuccesful in getting/creating a Word session then exit sub
MsgBox "Couldn't get an existing instance or create a new instance of Word", vbCritical
Exit Sub
End If
With WordApp 'reference the Word session you just got/created
.DisplayAlerts = wdAlertsNone
.Visible = True
On Error GoTo WordErrorHandler:
.Documents.Open ("C:\Users\mvandalen\Desktop\Test.docx")
' rest of your code exploiting the opened document
End With
On Error GoTo 0 'disable Word Error processing
' here goes the rest of your code to work without Word object/data
Exit Sub ' exit not to process statements following 'WordErrorHandler'
WordErrorHandler:
With WordApp
If .Documents.Count > 0 Then .Documents.Close '<<< Here it gives error 4605
.Quit
End With
Set WordApp = Nothing
Resume Next
End Sub
Save the document as a Template (.dotx) and change .Open() to .Add().
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add "C:\Users\mvandalen\Desktop\Test.dotx"
WordApp.Visible = True
'...
WordDoc.Close wdDoNotSaveChanges
Since you have a reference to Word, no need to call CreateObject("Word.Application").
Either remove the reference to Word Library and declare WordApp and WordDoc as Object, or use the New keyword.
This way you can open as many instances you want simultaneously.

MSWord .SaveAs vs .ExportAsFixedFormat

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?

Requested PaperSize is not available on the currently selected printer

I would like to copy some excel data in to a word document using VBA
The excel data is build for print area A3. After creating a word document, I am trying to set up paper size for new word document to A3. It is giving me a run time error
Run time error '5889'
Requested PaperSize is not available on the currently selected printer
VBA Code that I am using
Set obj = CreateObject("Word.Application")
obj.Visible = True
Set newobj = obj.Documents.Add
newobj.ActiveWindow.Selection.PageSetup.PaperSize = wdPaperA3
Sheets("Page1").Activate
Range("A1:Q18").Copy
newobj.ActiveWindow.Selection.PasteExcelTable False, False, True
newobj.ActiveWindow.Selection.InsertBreak Type:=7
Tried a different approach that is also giving me the same error
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = GetObject("", "Word.Application")
End If
With wdApp
.Documents.Add
.Visible = True
End With
With wdApp.Selection
.PageSetup.Orientation = wdOrientPortrait
.PageSetup.PaperSize = wdPaperA3
.PageSetup.MirrorMargins = wdNarrow
.PasteSpecial , Link:=False, DataType:=14, _
DisplayAsIcon:=False
End With
Set wdApp = Nothing

Excel VBA modifying word doc from excel - collection member error

Running below code is bringing up "requested member of the collection does not exist" All searches have not produced an solution.
Sub WordTemplate()
Dim objWordapp As Object
Set objWordapp = CreateObject("Word.Application")
fileStr = "\\int.chc.concepts.co.nz\users\CBotting\Documents\VBA programming\SD Basic Template.docx"
objWordapp.Documents.Open FileName:=fileStr
With objWordapp.Selection.Sections(1).Headers(wdHeaderFooterPrimary)
If .Range.Text <> vbCr Then
MsgBox .Range.Text
Else
MsgBox "Header is empty"
End If
End With
End Sub
I have tried many different variations of addressing the header object
The problem wasn't the late binding. The problem was that the VBA doesn't know the value of wdHeaderFooterPrimary without a reference to the Microsoft Word xx.x Object Library. I tell the VBA the value of wdHeaderFooterPrimary then your code would work without the reference to the Word library set.
Sub WordTemplate()
Const wdHeaderFooterPrimary = 1
Dim objWordapp As Object
Set objWordapp = CreateObject("Word.Application")
fileStr = "\\int.chc.concepts.co.nz\users\CBotting\Documents\VBA programming\SD Basic Template.docx"
objWordapp.Documents.Open Filename:=fileStr
With objWordapp.Selection.Sections(1).Headers(wdHeaderFooterPrimary)
If .Range.Text <> vbCr Then
MsgBox .Range.Text
Else
MsgBox "Header is empty"
End If
End With
End Sub
Am running early binding method so needed to set in the VBA Tools menu the Microsoft Word 16.0 Object Library. Now works