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
Related
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
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.
I have several word files. They are build like this
text
text
text
Name: Mick
Date: 1-1-1
text
text
Item: Item11 material: Gold
text
text
I am building a macro that can open a word file, put the name in Cell A1 and put the item in Cell A2. I have found a code on internet and adjusted it a little. The following code makes a selection from the beginning of the word doc until a word is found and copies that selection in a given cell.
I hope someone can show me how i can adjust this so the selection begins right before the needed value an stops after it
code below is for item:
Dim wdApp As Object, wdDoc As Object, wdRng As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.Visible = True
Set wdDoc = .Documents.Open("path", False, True, False)
With wdDoc
Set wdRng = .Range(0, 0)
With .Range
With .Find
.Text = "material"
.Forward = True
.MatchWholeWord = True
.MatchCase = True
.Execute
End With
If .Find.found = True Then
wdRng.End = .Duplicate.Start
Sheets("sheet1").Range("A2").value = wdRng
End If
End With
.Close False
End With
.Quit
End With
Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
Anyone any suggestions?
Try the procedure below. It will open the specified Word document, parse the required values via Regular Expressions, place those values into cells A1 and A2, and then close the Word document.
When calling the procedure, specify the full path and filename of the Word document.
For example: SetNameAndItem "C:\Temp\Doc1.docx"
Public Sub SetNameAndItem(strPath As String)
Dim wdApp As Object: Set wdApp = CreateObject("Word.Application")
Dim wdDoc As Object: Set wdDoc = wdApp.Documents.Open(strPath, False, True, False)
Dim objRegEx As Object: Set objRegEx = CreateObject("VBScript.RegExp")
Dim objMatches As Object
On Error GoTo ProcError
With objRegEx
.Global = False
.MultiLine = True
.IgnoreCase = False
.Pattern = "^Name:\s(.*?)$"
End With
Set objMatches = objRegEx.Execute(wdDoc.Content)
If objMatches.Count = 0 Then
Debug.Print "Name: No match."
Else
Range("A1").Value = objMatches(0).SubMatches(0)
End If
objRegEx.Pattern = "^Item:\s(.*?)\smaterial"
Set objMatches = objRegEx.Execute(wdDoc.Content)
If objMatches.Count = 0 Then
Debug.Print "Item: No match."
Else
Range("A2").Value = objMatches(0).SubMatches(0)
End If
ProcExit:
On Error Resume Next
wdDoc.Close False
wdApp.Quit
Set objMatches = Nothing
Set objRegEx = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Sub
ProcError:
MsgBox "Error# " & Err.Number & vbCrLf & Err.Description, , "SetNameAndItem"
Resume ProcExit
End Sub
Result:
Note: Please ensure that the line breaks in your Word document consist of the normal Carriage Return / Line Feed character combination (the results of pressing pressing the Enter key). When I copied/pasted the text from your Question, the document looked as expected, but what appeared to be line feeds were actually Vertical Tab characters, so the Regular Expressions did not work. I'm not saying there was any error on your part, it's probably an artifact of pasting text the web page. Just something to be aware of.
UPDATE:
If the Regular Expressions in the above code don't work, then perhaps it was not a copy/paste issue after all, and you really do have Vertical Tab characters in your document. If that's the case, try modifying the SetNameAndItem procedure in the Excel VBA code as follows.
Replace these two lines (which use ^ and $ to represent start and end of line, respectively):
.Pattern = "^Name:\s(.*?)$"
objRegEx.Pattern = "^Item:\s(.*?)\smaterial"
With these two lines (which use \v to represent vertical tab):
.Pattern = "\vName:\s(.*?)\v"
objRegEx.Pattern = "\vItem:\s(.*?)\smaterial"
Here is a possible solution of your problem:
Use this function to read the word file:
Option Explicit
Public Function f_my_story() as string
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.Visible = True
Set wdDoc = .Documents.Open("C:\Users\v\Desktop\text.docx", False, True, False)
f_my_story = wdDoc.Range(0, wdDoc.Range.End)
wdDoc.Close False
.Quit
End With
End Function
Once you have read the file, you get a string. Now you need a macro, which separates the string by space and it returns the values, that are after the values you are looking for.
You can write those values anywhere you want.
I am new to VBA and I am trying to put together a macro in Excel. This macro is to search a Word document for a specific text string and return the page number where it is located (i.e. the column will say "### is found on page # of the document").
I seem to be very close to what I want. The macro finds the text and I can get it to tell me it found/didn't find it. However, when I run it with code to return the page number, it tells me the index is out of range. I'm sure the difficulty is with my limited understanding of the objects and their properties.
Any help is appreciated!
Sub OpenWordDoc()
Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
wordapp.Activate
wordapp.Documents.Open "filename.docx"
Set findRange = Sheet1.Range("D4:D8")
For Each findCell In findRange.Cells
Set rngFound = wordapp.ActiveDocument.Range.Find
rngFound.Text = findCell.Value
rngFound.Execute
If rngFound.Found Then
findCell.Offset(columnOffset:=1) = rngFound.Parent.Information(wdActiveEndPageNumber)
Else
findCell.Offset(columnOffset:=1) = findCell.Value
End If
Next findCell
wordapp.Quit
Set wordapp = Nothing
End Sub
Edit 1: I have tried this on a completely different computer and different versions of Word and Excel. The same message pops up. The error is this piece - rngFound.Parent.Information(wdActiveEndPageNumber) - and I think the rngFound.Parent is not acting as a "selection". I also tried replacing the wdActiveEndPageNumber with wdNumberOfPagesInDocument just to see if it was the specific value and got the same error message.
Try something like this:
Sub OpenWordDoc()
Dim wordapp As Word.Application
Dim findRange As Excel.Range
Dim findCell As Excel.Range
Dim rngFound As Word.Range
Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
wordapp.Activate
wordapp.Documents.Open "filename.docx"
Set findRange = Sheet1.Range("D4:D8")
For Each findCell In findRange.Cells
Set rngFound = wordapp.ActiveDocument.Range
With rngFound.Find
.Text = findCell.Value
.Execute
End With
If rngFound.Find.Found Then
findCell.Offset(columnOffset:=1) = rngFound.Information(wdActiveEndPageNumber)
Else
findCell.Offset(columnOffset:=1) = findCell.Value
End If
Next findCell
wordapp.Quit
Set rngFound = Nothing
Set findCell = Nothing
Set findRange = Nothing
Set wordapp = Nothing
End Sub
Hope that helps
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.