Points property of ShapeNode fails in MS Word - vba

The Code below implements the example presented in the Microsoft ShapeNode.Points property (Word) article:
Sub Test()
Dim PointsArray
Dim myDocument As Document
Dim currXvalue As Single
Dim currYvalue As Single
Set myDocument = ActiveDocument
With myDocument.Shapes(3).Nodes
PointsArray = .Item(2).Points
currXvalue = PointsArray(1, 1)
currYvalue = PointsArray(1, 2)
.SetPosition 2, currXvalue + 200, currYvalue + 300
End With
End Sub
Execution of the line 3 generates the RTE 13 (Type Mismatch). According to the Watch panel,
the type of the Points property is the array of Single (which is
correct)
the type of the myDocument.Shapes(3).Nodes.Item(2).Points
expression is Integer
See the screenshot below:
Verified on MS Word 2007. A problem of this kind exists for Word 2010. However, it was verified that the problem does not exist for MS PowerPoint 2007 and MS Excel 2007.
Seems to be an error in the Word object model. Can you please suggest a workaround?

Related

Word Fill VBA in MS Access for various fields in table

For our incident management side of our database I am trying to have data from fields in my table(s) generate within the 149 Investigative Report, a Word document template provided by the state (see link here).
I made a read-only version of the document to preserve its integrity by forcing a save as by the user and loaded it with text form fields with bookmarks to reference (example: txtcaseintroduction).
I modified code I found in the internet for working with form fields and assigned it to a button on one of my forms to assist in generating the report (the Open reference is modified for security reasons):
Private Sub cmdPrint_Click()
'Export 149 Report.
Dim appWord As Word.Application
Dim doc As Word.Document
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Add("Y:\ABC\2018\Case Files\2018 - Incident Forms\OPWDD 149 - Access Database Reference.docx", , True)
With doc
.FormFields("txtNIMRS").Result = Me.NIMRSID
.FormFields("txtInternalID").Result = Me.InternalIncidentID
.FormFields("txtIncidentDate").Result = Me.[IncidentOccurrenceDate]
.FormFields("txtDiscoverydate").Result = Me.[IncidentReportDate]
.FormFields("txtCaseIntroduction").Result = Me.CaseIntroduction
.FormFields("txtIncidentLocation").Result = Me.Location
.FormFields("txtBackground").Result = Me.BackgroundInfo
.FormFields("txtProtections").Result = Me.ImmedProtec
.FormFields("txtQuestion").Result = Me.InvestQuestion
.FormFields("txtTestName").Result = Me.[TestimonialEvidence]
.FormFields("txtDocumentaryE").Result = Me.[DocumentaryEvidence]
.FormFields("txtDemonstrativeE").Result = Me.[DemonstrativeEvidence]
.FormFields("txtPhysicalE").Result = Me.[PhysicalEvidence]
.FormFields("txtWSName").Result = Me.[WrittenStatements]
.FormFields("txtSummary").Result = Me.SummaryEvidence
.FormFields("txtConclusions").Result = Me.Text409
.FormFields("txtRecommendations").Result = Me.Text411
.FormFields("txtInvestigator").Result = Me.Investigator_s__Assigned
.FormFields("txtdatereport").Result = Me.Investigative_Report_Completion_Date
.Visible = True
.Activate
End With
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
The following fields work:
.FormFields("txtNIMRS").Result = Me.NIMRSID
.FormFields("txtInternalID").Result = Me.InternalIncidentID
.FormFields("txtIncidentDate").Result = Me.[IncidentOccurrenceDate]
.FormFields("txtDiscoverydate").Result = Me.[IncidentReportDate]
.FormFields("txtIncidentLocation").Result = Me.Location
.FormFields("txtBackground").Result = Me.BackgroundInfo
.FormFields("txtProtections").Result = Me.ImmedProtec
.FormFields("txtQuestion").Result = Me.InvestQuestion
.FormFields("txtConclusions").Result = Me.Text409
.FormFields("txtRecommendations").Result = Me.Text411
.FormFields("txtdatereport").Result = Me.Investigative_Report_Completion_Date
The remaining fields (case introduction, investigator, and the attachment fields) do not. All of these fields exist on the same table. It is also noted that case introduction used to work, but stopped working as I tried to figure out more form fields to apply to the document and reference. The goal was to have the investigator essentially do all of their work in the database and then export it to the required format for submission to the state.
My question: what do I need to do to the above code to get the non-working fields functional in populating the Word document?
Responding to questions in comments
No error that occurs; the text-boxes are simply not populating when I engage the button.
The form fields do not need to be present in the result document. They are simply "targets" for the data.
Since the form fields do not need to be retained in the result document the simplest approach would be to simply insert the data to the FormField.Range, which will replace (remove) the form field. The entire code can be written in this manner if consistency is important (how the end result looks to the user), but from a programming stand-point need not be.
Note: If Forms protection is activated, it needs to be turned off for this approach to work
If doc.ProtectionType <> -1 Then doc.Unprotect '-1 = wdNoProtection
Sample code line for a string longer than 255 characters
.FormFields("txtCaseIntroduction").Range = Me.CaseIntroduction

To Use Shape.DrawSpline Method (Visio) from MS Access VBA

I was reading up on the use of Shape.DrawSpline Method (Visio) from MS office VBA reference. The example they gave works when I entered it within Visio. The example takes points and connect them with a curve and display it in the Visio application.
I wish to have the VBA code reside within MS Access and I will have VBA code open a Visio drawing, and execute the Shape.DrawSpline Method from MS Access VBA code. My problem seems to determine how to generate the expression shape to get the program to run and draw the sample curve in the open Visio drawing.
Here is the code I was working on, and the part that opens up a Visio drawing is working for me:
Dim AppVisio As Visio.Application
Dim ShpObj As Visio.Shape
Dim XYPoints(70) As Double
Set AppVisio = CreateObject("Visio.Application")
Set DocObj = AppVisio.Documents.Open("C:\Test Template.vsd")
When I command MS Access to execute the above code, the Visio Drawing "Test Template.vsd" does open it.
Immediately following the above code, I have the x, y coordinates of the points to be ploted. They are assigned to the XYPoints array.
At the bottom, I have the following code which was used to execute the DrawSpline Method (Visio) from MS Access VBA code.
Here is that code:
Set ShpObj = AppVisio.Application.ActivePage.DrawSpline(XYPoints, 0.25, visSplinePeriodic)
I get an error in the above statement. Here is the error I get:
"Run-time error '-2032465751 (86db08a9)'
Method 'DrawSpline' of object 'IVPage' failed
Thank You,
I agrree with #y4cine's advice. However my guess is either your document isn't opening correctly, or your populating of your points array isn't in the correct format. The following adaptation of the SDK sample works for me:
Sub TestSplineFromExcel()
Dim vApp As Visio.Application
Set vApp = CreateObject("Visio.Application")
Dim intCounter As Integer
Dim XYPoints(1 To (5 * 2)) As Double
For intCounter = 1 To 5
'Set x components (array elements 1,3,5,7,9) to 1,2,3,4,5
XYPoints((intCounter * 2) - 1) = intCounter
'Set y components (array elements 2,4,6,8,10) to f(i)
XYPoints(intCounter * 2) = (intCounter * intCounter) - (7 * intCounter) + 15
Next intCounter
vApp.Documents.Add ""
Dim vPag As Visio.Page
Set vPag = vApp.ActivePage
If vPag Is Nothing Then
MsgBox "Target page is null"
Else
Dim shp As Visio.Shape
Set shp = vPag.DrawSpline(XYPoints, 0.25, Visio.VisDrawSplineFlags.visSplinePeriodic)
End If
End Sub

Display an OLE Object from a table in a word doc [VBA]

So I need to display a picture in a word doc at a bookmark. This picture is stored in a MS Access Database as an OLE Object.
I know how to write at a bookmark
WordDoc.Bookmarks.Item("myBookmark").Range.Text = value
And for the moment, here what i've done:
'xNum is the product number
Dim s As OLEObjects
Dim x As Integer
Dim rs As DAO.Recordset
xSQL = "SELECT stuff FROM table1 LEFT JOIN table2 ON table1.par = table2.par WHERE NumProduct=" & xNum
Set rs = CurrentDb.OpenRecordset(xSQL)
s = rs!stuff
x = 1
Do While Not rs.EOF
If x = 1 Then
'{Command to insert an OLE at a word's bookmark}
ElseIf x = 2 Then
...
End If
rs.MoveNext
x = x + 1
Loop
rs.Close
Is there a solution to my problem?
P.S: I'm a newbie on vba/Ms Access, but I made some C# (which looks a bit like vba)
So I finally came up with a solution!
The idea is to put each picture (OLE Object) in an Image frame in an Access Form, and then focus this object (Image frame) in order to proceed a copy and paste in our word doc, at the specific range we just set before. By the way, this Image frame must be enabled, unlocked and visible.
Cordially, the developer who answers his self!

Open an Embedded Object in Excel using VBA

In an ms office document I've embedded / inserted an external document (object) (PDF in my case).
After opening the document, when I click on the PDF object icon, It opens up the PDF file embedded in it.
Using VBA / Macro I want to do the same thing, Where I'll have to run a macro and it will open up the embedded PDF file(Without clicking on the PDF ICON).
Is it possible?
Thanks,
Excel:
You can get the OLEObject form the OLEObjects of the Worksheet. See OLEObjects - https://msdn.microsoft.com/en-us/library/office/ff840244.aspx, OLEObject - https://msdn.microsoft.com/en-us/library/office/ff838421.aspx, OLEObject members - https://msdn.microsoft.com/EN-US/library/office/ff841208.aspx.
There is a method Verb which has a verb for opening the object. See https://msdn.microsoft.com/EN-US/library/office/ff838827.aspx - Verbs - https://msdn.microsoft.com/EN-US/library/office/ff820926.aspx
Example:
Sub test()
With ActiveSheet
Set o = .OLEObjects("Objekt 1")
o.Verb xlVerbOpen
End With
End Sub
"Objekt 1" is the name of the object in the Excel worksheet. The object must be in the active sheet.
Word:
In Word it depends on if the embedded object is in an InlineShape or an Shape. And there is no OLEObjects collection. So you must handle with Shape.OLEFormat. See InlineShapes - https://msdn.microsoft.com/en-us/library/office/ff822592.aspx, Shapes - https://msdn.microsoft.com/en-us/library/office/ff845240.aspx, Shape - https://msdn.microsoft.com/en-us/library/office/ff196943.aspx, OLEFormat - https://msdn.microsoft.com/EN-US/library/office/ff197153.aspx.
Example:
Sub test()
With ActiveDocument
Set oShape = .InlineShapes(1) 'The embedded object is the first InlineShape.
'Set oShape = .Shapes(1) 'The embedded object is the first Shape.
Set oOLEFormat = oShape.OLEFormat
oOLEFormat.Open
End With
End Sub
In short, when you already know which object you are referring to:
Excel
Sheets("Sheet1").OLEObjects("Object 1").Activate
Word
ActiveDocument.InlineShapes(1).OLEFormat.Open
Try this:
Sub test()
With ActiveSheet
Set o = .OLEObjects("Objekt 1")
o.Verb xlPrimary
End With
End Sub

How can I dynamically construct a textbox object reference?

I asked a similar question Here and now I need to do the same thing again but this time using VBA in Excel 2010.
Essentially I have numerous text boxes with generic names (i.e. textbox1,textbox2 etc). How can I programically construct the object reference so that I can create a loop?
EDIT:
It is a regular textbox on a worksheet. When I start a sub for this worksheet I can reference the textboxes with the following line:
TextBox1.LinkedCell = "B2"
This is what your after:
Dim oleObj As OLEObject
'Dim oleTxtBox As TextBox
For Each oleObj In Sheet1.OLEObjects
If oleObj.OLEType = xlOLEControl Then
If Mid(oleObj.progID, 1, 14) = "Forms.TextBox." Then
Set oleTxtBox = oleObj.Object
oleTxtBox.PasswordChar = "*"
End If
End If
Next
Just using PasswordChar as an example field from the TextBox object, but it wouldn't actually left me Dim as a TextBox