I have created the below code for exporting an embedded Word document in a Excel Sheet to the workbook's path:
Private Sub Export()
Dim sh As Shape
Dim objWord As Object 'Word.Document
Dim objOLE As OLEObject
Set sh = Sheet1.Shapes("Object 1")
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object
objWord.SaveAs2 Filename:=ActiveWorkbook.Path & "\MyTemplate.docx", FileFormat:= _
wdFormatDocumentDefault
End Sub
The above code is working fine, but I was looking to add that the Word Applications starts as invisible and that it exits MS Word at the end of the code. I have tried using objWord.Visible = False and objWord.Quit but when I add these lines I get an "Object doesn't support this property or method" error.
Please advise.
I guess you want this
objWord.Application.Visible = False
and this
objWord.Application.Quit
Related
I have an excel with a specific column having text in multiple lines within each cells. I want to copy that multi-line text into word document as sentence in word format. I tried several codes but all that copies the excel range and pastes in word exactly the same way it is in excel including the cell borders. I do not want cell borders. I want text to be copied as a sentence/paragraph. Can someone please help me with this.
Here is the code i'm using:
Public Sub CommandButton1_Click()
On Error GoTo ErrorHandler
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application.8")
wApp.Visible = True
Const strPath1 As String = "D:\Template.docx"
Set wDoc = wApp.Documents.Add(Template:=strPath1, NewTemplate:=False, DocumentType:=0)
Worksheets("Sheet2").Range(ActiveCell, ActiveCell.End(xlDown)).Copy
With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
.Paste
End With
ErrorHandler:
Resume Next
End Sub
You don't want to use copy and paste, you need to use the Excel VBA object model to reference the cell you want and then access the text using cell.Value.
You must already be using Excel.Application, and you must already be referencing the cell since you copy and paste the value, so swap the code you have to copy and paste with the code to use the cell.value.
Unfortunately, I'm not at my computer so I can't test this, but you want to replace your code with something like
Public Sub CommandButton1_Click()
On Error GoTo ErrorHandler
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application.8")
wApp.Visible = True
Const strPath1 As String = "D:\Template.docx"
Set wDoc = wApp.Documents.Add(Template:=strPath1, NewTemplate:=False, DocumentType:=0)
Dim currentcell as variant
Dim result as string
For each currentcell in Worksheets("Sheet2").Range(ActiveCell, ActiveCell.End(xlDown))
Result =result & currentcell.value & vbcrlf
Next currentcell
With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
.Text= result
End With
ErrorHandler:
Resume Next
End Sub
I am trying to build a report generator using an excel database. I would like to insert photos into word bookmarks from an HTML link. I am wondering if it is possible to do this?
Right now my code is set up to test if I can insert the photos from the HTML link alone. Here is what it looks like:
Sub photobomb
Dim imagePath As String
imagePath ="https://dl.dropbox.com/s/uywzy5yf08apk68/130%20Boreal%20Avenuexx.jpg"
With ActiveDocument
.Bookmarks("imagePath1").Range
.InlineShapes.AddPicture FileName:= "imagePath", _
LinkToFile:=False, _
SaveWithDocument:=False, _
End With
End Sub
The code keeps failing. Any help is greatly appreciated, thanks.
That is because your code is slightly incorrect. Also imagePath is a variable. When you put it within Quotes, it becomes a string. Since I don't have access to the picture link mentioned in your post, I am using a different link.
Try this (In MS Word)
Sub photobomb()
Dim imagePath As String
imagePath = "https://www.dropbox.com/static/images/lockbox.png"
ActiveDocument.Bookmarks("imagePath1").Range.InlineShapes.AddPicture FileName:=imagePath
End Sub
Now all you need to do is LateBind/EarlyBind from Excel to Word and use the above code.
Here is small example which is Untested. Paste this code in an Excel module and run it
Sub Sample()
Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String
Dim imagePath As String
'~~> Change link and path accordingly
imagePath = "https://www.dropbox.com/static/images/lockbox.png"
FlName = "C:\MyFile.Docx"
'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(FlName)
oWordDoc.Bookmarks("imagePath1").Range.InlineShapes.AddPicture Filename:=imagePath
End Sub
I am trying to write a code that copies the contents of multiple worksheets in a single workbook into a single word document. I want the content of each worksheet to be on its own page, but right now, my code is just copying and pasting over each other instead of going onto a new page and pasting. I've tried going to the end of the document but it isn't working... Any advice would be helpful.
Sub ToWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
Dim strdocname As String
'file name & folder path
On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'create new instance of word application
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "C:\Doc.doc"
If Dir(strdocname) = "" Then
MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Doc.doc", vbExclamation, "The document does not exist "
Exit Sub
End If
wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Next ws
'Clean up
Set wddoc = Nothing
Set wdapp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
you can just use:
wddoc.Range(i).Paste
incrementing i by 1 after each image. that pastes them one after another.
or more simply:
wddoc.Range(wddoc.Characters.Count-1).Paste
then could get more complicated and add a page break manually in between each if images are small to ensure a new page for each:
wddoc.Range(wddoc.Characters.Count-1).InsertBreak Type:=7
https://msdn.microsoft.com/en-us/library/office/ff821608.aspx
EDIT
First, I incorrectly assumed the "wddoc.range" property would get wherever the cursor is. This is not true. You need to use the code provided by Miss Palmer (and replicated below).
However, there is an additional issue I didn't notice at first. Your loop is set incorrectly. You are looping through and continually reopening the word doc. You need to move these lines:
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
so that they are immediately above the
wddoc.Range(wddoc.Characters.Count - 1).Paste
line. This will cause the loop to be executed properly and only open the word doc once.
Also (again, per Miss Palmer), you want to put this:
wddoc.Range(wddoc.Characters.Count - 1).Paste
wddoc.Range(wddoc.Characters.Count - 1).InsertBreak (wdPageBreak)after the line:
instead of the ".range.paste" that you originially had.
The other issue with your "Selection" line is that you did not specify the application you wanted to use. This was using Excel's selection by default as it was being run from Excel.
This code assumes that you have a word document that doesn't have enough pages. Otherwise you could likely use the code you want, but it's unclear why you would have a blank word document with many pages. You'd still need to specify the app you want to move to the next page in, so put "wdapp." before the selection line.
http://word.tips.net/T000120_Jumping_to_the_Start_or_End_of_a_Document.html
I am copying Excel cell contents to a bookmark on a Form Edit restricted (2010) Word document but it will only paste if the protection is turned off.
The code I currently have to turn the protection on again afterwards errors. What is the correct code?
Is there a way to make this copy and paste without turning off the protection?
Second problem is that when the text is pasted to the bookmark the font is Red (if manually entered on the document it is in black). The Word default is set as black (I reset the default for good measure). Typing in a new document is in black, however, when Word opens the font icon shows red even though checking the default it is still shows black. Can I define the font colour in the VBA to override this issue until is is resolved or can you suggest a way to fix the Word default?
Sub Arzbericht_Brandstetter()
' x - Defined Cell Names - ARTBrandPATH , ARTBrandDOC
' Excel Word Bookmark
' x - Defined Cell Names - ARZKrankenhaus Text65
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Dim Wd As Object
Dim wdDoc As Object
Dim BrandstetterDoc As Object
Dim BrandstetterPath As String
Dim f As Boolean
BrandstetterPath = ActiveSheet.Range("ARTBrandPATH").Value & ActiveSheet.Range("ARTBrandDOC").Value & ".doc" ' x
' On Error Resume Next
Set BrandstetterDoc = GetObject(BrandstetterPath)
If BrandstetterDoc 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 BrandstetterDoc = Wd.Documents.Open(BrandstetterPath)
If BrandstetterDoc Is Nothing Then
MsgBox "Failed to open Brandstetter Document!" & vbNewLine & _
" Check File Directory is correct", vbCritical
If f Then
Wd.Quit
End If
Exit Sub
End If
Wd.Visible = True
Else
With BrandstetterDoc.Parent
.Visible = True
.Activate
' Turn Protection OFF
With ActiveDocument
.Unprotect "xxxxx"
.Protect wdAllowOnlyRevisions, , Password:="xxxxx"
End With
BrandstetterDoc.Bookmarks("Text65").Range.Text = ws.Range("ARZKrankenhaus").Value
' Turn Protection ON (Restricted Editing)
' ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End With
End If
End Sub
Because its a Formfield and not just a bookmark I changing the code as below which resolved the strange red font issue. I can now copy to the document protected.
From
BrandstetterDoc.Bookmarks("Text65").Range.Text = ws.Range("ARZKrankenhaus").Value
To
ActiveDocument.FormFields("Text65").Result = ws.Range("ARZKrankenhaus").Value
I'm trying to copy the values from a named range in Excel to a bookmark in Word. I found this code on the web that does it in Excel VBA, but I'm getting an Error 13.
Set pappWord = CreateObject("Word.Application")
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
I know that the line that is causing the error is:
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
What am i doing wrong? Also, how & where would I code so that I can export the doc to PDF?
Thanks in advance.
Note: I've already selected the reference to the Microsoft Word (version number 14) Object model in Excel
so I use it to accomplish this task but taking an image from formatted Excel table.
Sub FromExcelToWord()
Dim rg As Range
For Each xlName In wb.Names
If docWord.Bookmarks.Exists(xlName.Name) Then
Set rg = Range(xlName.Value)
rg.Copy
docWord.ActiveWindow.Selection.Goto what:=-1, Name:=xlName.Name
docWord.ActiveWindow.Selection.PasteSpecial link:=False, DataType:=wdPasteEnhancedMetafile, Placement:= _
0, DisplayAsIcon:=False
End If
Next xlName
End Sub
Just curious... Why are you adding a document rather than opening the relevant doc which has the bookmarks? Try this code (I usually test the code before posting but I haven't tested this particular code. Just quickly wrote it)
Also I am using Late Binding so no reference to the Word Object Library is required.
Sub Sample()
Dim wb As Workbook
Dim pappWord As Object, docWord As Object
Dim FlName As String
Dim xlName As Name
FlName = "C:\MyDoc.Doc" '<~~ Name of the file which has bookmarks
'~~> Establish an Word application object
On Error Resume Next
Set pappWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set pappWord = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
Set docWord = pappWord.Documents.Open(FlName)
Set wb = ActiveWorkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Value
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
End Sub
EDIT
Changed
Range(xlName.Value)
to
Range(xlName).Value
Now the above code is TRIED AND TESTED :)