Writing from Excel, to Word Activex Text box - excel

I have an Excel application which collects information via a form based interface. This is used to;
Fill values in the workbook
A procedure opens a Word document (template essentially) and names the file according to rules, based
on some of the input data. (Okay to this point)
The idea then, is to transfer collected information (from the Excel app driving this process) to
the same Word document opened and named.
Specifically, I intend to populate a number of uniquely named ActiveX textboxes with document.
*** This is where I fail miserably.
I have enabled the "Microsoft Word 16.0 Object Library" under references in the MSExcel VBA environment.
Given that I know the name/title of the content control (ActiveX textbox is a 'content control' isn't it?). The code below is a simplified example, if it works for the example I should be able to sort out the broader document:
Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
On error resume next
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
Dim cc As Object
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_PersonName) 'txt_PersonName is the control name
cc.Range.Text = "SUCCESS" 'Run-time error 438
'Object does not support property or method
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_Address) 'txt_Address is the control name
cc.Range.Text = "SUCCESS" 'Run-time error 438
'Object does not support property or method
End Sub
Anybody able to assist? There are a lot of text boxes in the Word document I wish to plug in to.
Thanks in advance.

OK, so I kept digging (I don't like accepting defeat) and found that my entire premise was wrong! ActiveX controls in Word are considered "InlineShapes" not "ContentControls". But the results I was reading in the internet searches had me confused (didn't claim to be the sharpest tool in the shed).
Once I realised this, some more digging provided the answer (see below).
So, first to list the 3 controls in my document (and their index) with the following Sub
Sub ListActiveXControls()
Dim i As Integer
i = 1
Do Until i > ActiveDocument.InlineShapes.Count
Debug.Print ActiveDocument.InlineShapes(i).OLEFormat.Object.Name & " Control Index = " & i
i = i + 1
Loop
End Sub
Now moving to EXCEL, I used the following:
Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
debug.print "ActiveDocument Name is : " & ActiveDocument.Name
' Result = Nothing
' Allowing the code to continue without the pause caused the operation to fail
Application.Wait (Now + TimeValue("0:00:10")) ' See text below, would not work without pause
wdDoc.Activate
' Begin set ActiveX control values. In this instance,
' The first line corresponds to 'Textbox1'
ActiveDocument.InlineShapes(1).OLEFormat.Object.Text = "Success"
' The second line corresponds to 'Textbox2'
ActiveDocument.InlineShapes(2).OLEFormat.Object.Text = "Success"
' The third line corresponds to 'ChkBox1'
ActiveDocument.InlineShapes(3).OLEFormat.Object.Value = True
End Sub
For some reason, without the 'Wait' command, the operation fails. Stepping through, if there is no pause, the ActiveDocument seems to be null, no idea why. It occurs with a document with 2 ActiveX controls or 165 ActiveX controls and the wait required seems to
be 10 secs on my PC. Incidentally, setting almost 150 control values was only seconds, once the wait period was completed.
If anyone knows why the 'Wait' is seemingly required, I'd be interested to know!

Here are a few tips to help you work this out.
Don't use On Error Resume Next unless you really need it. And then when you do use it, re-enable error catching with On Error Goto 0 as quickly as possible. Otherwise you'll miss many errors in your code and it will be hard to tell what's happening.
Don't use the name Word as a variable name. It is reserved for the Word.Application and will only confuse the compiler (and you).
The control titles are text strings, so you must enclose them in double-quotes.
I've thrown in a bonus Sub that gives you a quick method to either open a new Word application instance or attach to an existing application instance. You'll find that (especially during debugging) there will be dozens of Word exe's opened and running.
The example code below also breaks the assignment of your "SUCCESS" value to the control into a separate Sub. It's in this short Sub that using On Error Resume Next is appropriate -- and isolated from the rest of the logic -- limiting its scope.
Option Explicit
Sub trial()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = AttachToMSWordApplication
Set wdDoc = wdApp.Documents.Open("C:\Temp\Customer.docm")
wdApp.Application.Visible = True
TextToControl wdDoc, "txt_PersonName", "SUCCESS"
TextToControl wdDoc, "txt_Address", "SUCCESS"
End Sub
Private Sub TextToControl(ByRef doc As Word.Document, _
ByVal title As String, _
ByVal value As String)
Dim cc As ContentControl
On Error Resume Next
Set cc = doc.SelectContentControlsByTitle(title).Item(1)
If Not cc Is Nothing Then
cc.Range.Text = value
Else
Debug.Print "ERROR: could not find control titled '" & title & "'"
'--- you could also raise an error here to be handled by the caller
End If
End Sub
Public Function AttachToMSWordApplication() As Word.Application
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function

Related

Delete all comments of Wordfile

so I'm trying to delete all comments in a Wordfile per VBA-Code of an Excelfile.
I've tried using
'Dim ObjWord as Word.Application
ObjWord.ActiveDocument.DeleteAllComments
and calling
Sub RemoveAllComments(Doc As Document)
Dim n As Long
Dim oComments As Comments
Set oComments = Doc.Comments
For n = oComments.Count To 1 Step -1
oComments(n).Delete
Next
Set oComments = Nothing
End Sub
but the first gave me the run-time 'error 4605 command not available' and the second code segment throws an 'error 438 object doesn't support this property or method'.
Is there any other way I could do it?
Edit 1:
Dim ObjWord As Word.Application
Set ObjWord = LoadWord()
ObjWord.Visible = True
is in the Function and it calls LoadWord():
Function LoadWord() As Word.Application
Set LoadWord = GetObject(, "Word.Application")
If MsgBox("Word's already in use klick ok to dismiss all changes", vbOKCancel) = vbCancel Then
Set LoadWord = Nothing
End If
Exit Function
End Function
Error 4605 with:
ObjWord.ActiveDocument.DeleteAllComments
indicates the ActiveDocument (if there is one) contains no comments. Since you haven't posted any code relating to how the ActiveDocument (or Doc, in your second sub) is instantiated, or whether you've established that the document concerned even contains any comments, it is impossible to give further advice in that regard.
Furthermore, this:
Sub RemoveAllComments(Doc As Document)
would be invalid. At the very least it would need to be:
Sub RemoveAllComments(Doc As ObjWord.Document)
For the first example, the situation can be remedied with nothing more complicated than:
On Error Resume Next
ObjWord.ActiveDocument.DeleteAllComments
On Error Goto 0

Creating a multilevel list in Outlook from Excel VBA

I am working with excel to process user input and then output an standardized email based on the input, and then take that formatted text and save it to a variable to later add it to the clipboard for ease of entry into a system we use for internal documentation.
I have a functioning approach using HTML for the email format, but that doesn't resolve my intent to have it copy the code to the clipboard or variable as the HTML tags are copied as well. I'm hoping to get the functionality of Word's bullet lists so I've been trying to adapt the MS Word code in a way that can be called on demand.
I currently have the default excel libraries, form library and object library for Word and Outlook added to the program.
My goal is to pass an array list built on excel tables through the Word list and have it format and write the text to Word editor in an outlook draft. There will be varying number of sections (No more than 6) needed to be written, typically no more than 10 items per section, usually less. So I intend to have other sub/functions call this to format each section as needed.
Attached is an example of output for this section, along with an example of where the data is coming from. Each section will have it's own sheet in Excel. The second level of the list for each section will come from a separate sheet.
I included a portion of the actual code showing the startup of a new outlook draft and entry of text. EmailBody() currently just handles any text outside of these sections, and calls a separate function for each section to parse the tables (currently as unformatted text, and only inputting line breaks).
Output Example
Data source example
Sub Email()
Dim eTo As String
eTo = Range("H4").Value
Dim myItem As Object
Dim myInspector As Outlook.Inspector
Dim wdDoc As Word.Document
Dim wdRange As Word.Range
Set myItem = Outlook.Application.CreateItem(olMailItem)
With myItem
.To = eTo
.Bcc = "email"
.Subject = CNum("pt 1") & " | " & CNum("pt 2")
'displays message prior to send to ensure no errors in email. Autosend is possible, but not recommended.
.Display
Set myInspector = .GetInspector
'Obtain the Word.Document for the Inspector
Set wdDoc = myInspector.WordEditor
If Not (wdDoc Is Nothing) Then
Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
wdRange.InsertAfter (EmailBody(CNum("pt 1"), CNum("pt 2")))
End If
'[...]
end with
end sub
Multilevel list code I am struggling to adapt. I keep getting an error on the commented out section of code, and unsure of how to properly correct it so that it both functions and can be called on demand:
Run-time error '450': Wrong number of arguments or invalid property
assignment
Sub testList()
Dim arr1 As Object
Set arr1 = CreateObject("System.Collections.ArrayList")
With arr1
.Add "test" & " $100"
.Add "apple"
.Add "four"
End With
Dim i As Long
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = InchesToPoints(0.25)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(0.5)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = ""
End With
ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
'Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
' ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
' False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
' wdWord10ListBehavior
'writes each item in ArrayList to document
For i = 0 To arr1.Count - 1
Selection.TypeText Text:=arr1(i)
Selection.TypeParagraph
Next i
'writes each item to level 2 list
Selection.Range.SetListLevel Level:=2
For i = 0 To arr1.Count - 1
Selection.TypeText Text:=arr1(i)
Selection.TypeParagraph
Next i
Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
arr1.Clear
End Sub
Please forgive me if any of this seems inefficient, or an odd approach. I literally pickup up VBA a few weeks ago and only have a few hours of application in between my job responsibilities with what I've learned so far. Any assistance would be much appreciated.
The reason why you are getting that error is because, it is not able to resolve the object Selection. You need to fully qualify the Selection object else Excel will refer to the current selection from Excel.
You may have referenced the Word Object library from Excel but that is not enough. The simplest way to reproduce this error is by running this from Excel
Sub Sample()
Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
End Sub
Here is a sample code which will work. To test this, open a word document and select some text and then run this code from Excel
Sub Sample()
Dim wrd As Object
Set wrd = GetObject(, "word.application")
wrd.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= wdWord10ListBehavior
End Sub
Applying this to your code. You need to work with the Word objects and fully qualify your objects like Word Application, Word Document, Word Range etc. For example
Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String
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)
With oWordDoc
'
'~~> Rest of the code here
'
End With
Utilizing Word lists, while functional in this circumstance created a certain tedium in coding due to the need to declare both Word and Outlook objects and resolve their relation to each other.
It appears I was declaring my HTML lists incorrectly in my original code. I shifted the margin of the <li> rather than nesting <ul> to step the list.
By nesting the HTML list tags you can get the same functionality of a word list and the formatting will persist when copied to other text editors. However, copying must be done after it is written to .HTMLBody.
<ul><li>Apple</li><ul><li>Fruit</li></ul></ul>
or for VBA:
.HTMLBody = "<ul><li>" & arg1 & "</li><ul><li>" & arg2 & "</li></ul></ul>"
The above will output this to .HTMLBody:
AppleFruit
To copy the text you only need to select all the text in the Outlook word editor and then assign it to the clipboard if pasting as is, or assign it to a variable if additional changes are needed before putting it in the clipboard.

How do I copy the contents of one word document to the end of another using vba?

Goal for my project:
I want to be able to copy the contents of one document and append that selection to the end of another document.
What it does... (this is just background info so you understand why I am trying to do this):
I am trying to dynamically produce a document which quotes a variety of information regarding different parts and materials involved for a product.
The document itself has a consistent format which I have broken down and separated into two documents. The first contains a bunch of data that needs to be entered manually, and is where I want to append all additional content. The second contains roughly a dozen custom fields which are updated from an excel spreadsheet in VBA. For a single part and as a single doc this works as I want it (my base case). However my issue is when there are multiple parts for a project.
The Problem:
For multiple parts I have to store information in an array which changes in size dynamically as each additional part is added. When someone has added all the necessary parts they can select a button called "Create Quote".
Create quote runs a procedure which creates/opens separate copies of the two template documents mentioned above (saved on my computer). It then iterates through the array of parts and updates all the custom field in the 2nd document (no problems). Now I just need the contents of the 2nd document appended to the end of the first which is my problem.
What I want:
Ideally, my procedure will continue to iterate through every part in the array - updating custom fields, copy then paste the updated text, repeat... Until every part is included in the newly generated quote.
What I Tried - this code can be found in my generate quote procedure
I have tried many of the examples and suggestions provided by people who had similar question, but I don't know if its because I am operating from an excel doc, but many of their solution have not worked for me.
This is my most recent attempt and occurs after each iteration of the for loop
wrdDoc2.Fields.Update 'Update all the fields in the format document
wrdDoc2.Activate
Selection.WholeStory ' I want to select the entire document
Selection.Copy ' Copy the doc
wrdDoc1.Activate ' Set focus to the target document
Selection.EndKey wdStory ' I want the selection to be pasted to the end of the document
Selection.PasteAndFormat wdPasteDefault
QUOTE PROCEDURE - I am only including a handful of the fields I am updating because its not necessary to show them all
Private Sub quote_button_Click()
On Error GoTo RunError
Dim wrdApp1, wrdApp2 As Word.Application
Dim wrdDoc1, wrdDoc2 As Word.Document
Set wrdApp1 = CreateObject("Word.Application")
Set wrdApp2 = CreateObject("Word.Application")
wrdApp1.Visible = True
wrdApp2.Visible = True
Set wrdDoc1 = wrdApp1.Documents.Add(Template:="C:\MWES\AQT_v1.1(start).docm", NewTemplate:=False, DocumentType:=0)
Set wrdDoc2 = wrdApp2.Documents.Add(Template:="C:\MWES\AQT_v2.1(format).docm", NewTemplate:=False, DocumentType:=0)
Dim propName As String
For i = LBound(part_array, 1) To UBound(part_array, 1)
For Each prop In wrdDoc2.CustomDocumentProperties
propName = prop.name
' Looks for and sets the property name to custom values of select properties
With wrdDoc2.CustomDocumentProperties(propName)
Select Case propName
Case "EST_Quantity"
.value = part_array(i, 0) ' "QTY" ' Sheet1.Cells(1, 3) 'NA
Case "EST_Metal_Number"
.value = part_array(i, 1) ' "METAL_#" ' Sheet1.Cells(2, 3) 'NA"
Case "EST_Metal_Name"
.value = part_array(i, 2) ' "METAL_N" ' Sheet1.Cells(5, 2)
End Select
End With
Next prop ' Iterates until all the custom properties are set
wrdDoc2.Fields.Update 'Update all the fields in the format document
wrdDoc2.Activate
Selection.WholeStory ' I want to select the entire document
Selection.Copy ' Copy the doc
wrdDoc1.Activate ' Set focus to the target document
Selection.EndKey wdStory ' I want the selection to be pasted to the end of the document
Selection.PasteAndFormat wdPasteDefault
Next i ' update the document for the next part
RunError: ' Reportd any errors that might occur in the system
If Err.Number = 0 Then
Debug.Print "IGNORE ERROR 0!"
Else
Dim strError As String
strError = "ERROR: " & Err.Number & vbCrLf & Err.Description & vbCrLf & Erl
MsgBox strError
Debug.Print strError & " LINE: " & Erl
End If
End Sub
I apologize this was so long winded. Let me know if there is anything confusing or you may want clarified. I think I included everything though.
I think you're close, so here are a couple of comments and an example.
First of all, you're opening two separate MS Word Application objects. You only need one. In fact, it's possible that the copy/paste is failing because you're trying to copy from one Word app to a document opened in the other. (Trust me, I've seen weird things like this.) My example below shows how to do this by only opening a single application instance.
Dim mswApp As Word.Application
Set mswApp = AttachToMSWordApplication() 'more on this function below...
Dim doc1 As Word.Document
Dim doc2 As Word.Document
Set doc1 = mswApp.Documents.Open("C:\Temp\combined.docx")
Set doc2 = mswApp.Documents.Open("C:\Temp\control.docx")
While I don't often write code for Word, I've found that there are so many different ways to get at the same content using different objects or properties. This is always a source of confusion.
Based on this answer, which has worked well for me in the past, I then set up the source and destination ranges to perform the "copy":
Dim destination As Word.Range
Dim source As Word.Range
Set source = doc1.Content
Set destination = doc2.Content
destination.Collapse Direction:=Word.wdCollapseEnd
destination.FormattedText = source
Here is the whole module for reference:
Option Explicit
Sub AddDocs()
Dim wordWasRunning As Boolean
wordWasRunning = IsMSWordRunning()
Dim mswApp As Word.Application
Set mswApp = AttachToMSWordApplication()
Dim doc1 As Word.Document
Dim doc2 As Word.Document
Set doc1 = mswApp.Documents.Open("C:\Temp\combined.docx")
Set doc2 = mswApp.Documents.Open("C:\Temp\control.docx")
Dim destination As Word.Range
Dim source As Word.Range
Set source = doc1.Content
Set destination = doc2.Content
destination.Collapse Direction:=Word.wdCollapseEnd
destination.FormattedText = source
doc2.Close SaveChanges:=True
doc1.Close
If Not wordWasRunning Then
mswApp.Quit
End If
End Sub
Here's the promised note on a couple functions I use in the sample. I've built up a set of library functions, several of which help me access other Office applications. I save these modules as .bas files (by using the Export function in the VBA Editor) and import them as needed. So if you'd like to use it, just save the code below in using a plain text editor (NOT in the VBA Editor!), then import that file into your project.
Suggested filename is Lib_MSWordSupport.bas:
Attribute VB_Name = "Lib_MSWordSupport"
Attribute VB_Description = "Variety of support functions operating on MS Word"
Option Explicit
Public Function IsMSWordRunning() As Boolean
Attribute IsMSWordRunning.VB_Description = "quick check to see if an instance of MS Word is running"
'--- quick check to see if an instance of MS Word is running
Dim msApp As Object
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- not running
IsMSWordRunning = False
Else
'--- running
IsMSWordRunning = True
End If
End Function
Public Function AttachToMSWordApplication() As Word.Application
Attribute AttachToMSWordApplication.VB_Description = "finds an existing and running instance of MS Word, or starts the application if one is not already running"
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function

VBA: Editing Word document with Excel gives run-time error 438: Object doesn't support this property or method

In spite of heavy googling, I am not able to figure out, what is wrong with this. Do I still miss a reference or something? If you can see, where the error lies, I'll be forever grateful!
References:
Visual Basic For Applications
Microsoft Excel 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Object Library
RefEdit Control
Microsoft Word 16.0 Object Library
Variables:
Public appWord As Word.Application
Public sapmWord As Word.Document
Dim asNimi As String 'in this current sub
Code:
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err <> 0 Then
Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0
appWord.Visible = True
Set sapmWord = appWord.documents.Open("C:\ThisIsWorking\andDocOpens.docx")
'sapmWord.Activate 'doesn't make a difference
With sapmWord
Selection.EndKey Unit = wdStory 'this line is first line to give an error. With or without a dot in the beginning of line.
Selection.TypeText Text:=asNimi 'this line too, if previous is commented
'...and so on!
End With
sapmWord.Close savechanges:=True
Set appWord = Nothing
Set sapmWord = Nothing
sapmWord is a word document. A word document doesn't have a selection method. The Word application object has it, so probably you mean (and yes, you need the '.')
With appWord
.Selection.EndKey Unit:= wdStory
.Selection.TypeText Text:=asNimi
'...and so on!
End With
You have to change sapmWord.Close savechanges:=True for appWord.quit savechanges:=True
To use With, you must reference members with a .:
With sapmWord
.Selection.EndKey Unit = wdStory
.Selection.TypeText Text:=asNimi
End With
At the end I had no choice but adding bookmarks to the Word document and filling them with VBA. I still have no clue why those original codes did not work in my code, although they work for others. Thank you all for help, maybe some one else is getting answers here anyway.

Can't work on Word CommandButton object from within Excel

I'm writing an Excel macro that opens up a Word document and looks for a CommandButton object, by Name. When it finds the object, it tries to check if it has a picture associated with it. It seems to be locating the object, but dies a "catastrophic" death when I try to reference the handle of the picture. I've done this before and looking to see if the picture's handle is zero has worked for me. Not sure what's up here, maybe someone else can see what I'm missing?
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Set cmdSignatureButton = fncGetCommandButtonByName("NameOfCommandButtonImLookingFor", objDoc)
MsgBox "h=" & cmdSignatureButton.Picture.Handle
' It dies here, giving the error:
' Runtime error -2147418113 (8000ffff)
' Automation error
' Catastrophic failure
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document)
Dim obj As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
MsgBox "Found the Command Button object" ' Seems to find the CommandButton object here
Exit Function
End If
End If
End With
Next
End Function
I was able to get this functioning without an issue. You may want to step through the code to see if the document is fully loaded first.
Here's the code that's working for me, edited to match the format of the original question posed.
Dim objWord As Object: Set objWord = CreateObject("Word.Application")
Dim objDoc As Object: Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Dim cmdSignatureButton As Object
Set cmdSignatureButton = fncGetCommandButtonByName("CommandButton1", objDoc)
If Not cmdSignatureButton Is Nothing Then
'Do something when it isn't nothing
MsgBox "h=" & cmdSignatureButton.Picture.Handle
Else
'Something here
End If
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document) As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
Exit Function
End If
End If
End With
Next
Set fncGetCommandButtonByName = Nothing 'set it equal to nothing when it fails
End Function
If you are still receiving that error, I'm thinking it may have something to do with the picture not being fully loaded. If so, I'd add some error handling to catch that error and process a retry a second later to see if the picture's handle is available.
Here's what I get when I run that code:
OK, I think I have an approach, at least. I moved on to my next problem, which is very similar. In this case, I am looking for images within Command Buttons within an Excel spreadsheet, but I'm doing so from Access. Instead of trying to jump through hoops and get Access VBA to interrogate the Excel file, I put a Public Function into the Excel file that Access calls. Excel has no problem checking the button for an image, so it just returns the answer for me.
Had to figure out how to Run Public Functions, but that was easy enough. Thanks for the feedback, Ryan. Still not sure why yours worked and mine didn't, but at least I got around it.

Resources