This code "Selection.CreateTextbox" works in a word version 93-2001 file, but not in a word 2010 file

Question

I have an Excel routine that transfers data from the Excel file into a Word document. The program works when the files are saved as Office 97-2003, but crashes when I update the files to Office 2010. The problem relates to the part of the programming that puts a text box around photos and adds a caption. This part of the programming is called from Excel but the subroutine is in Word. The subroutine "ResizePic" that resizes the images works, but subroutine “AddPictureBox” does not. Can somebody provide me with code that will work in Office 2010 and 2013. I don’t care if it will still work in the earlier version. Note that I did not originally write this code and I am not an advanced user. Only the relevant parts of the CreateDocumment subroutine are shown.

sub CreateReport()
Set wdApp = GetObject("", "Word.Application")
wdApp.Documents.Open FileName:=strDefaultPath & "\tempReport.doc",   ReadOnly:=True 
Excel.Sheets("Export").Activate
'add line items from Excel
i = 1
Do Until IsEmpty(Excel.Sheets("Export").Cells(i, 5))  
wdApp.Selection.Goto What:=-1, Name:="WorkItemList" 
strItemName = Excel.Sheets("Export").Range("b" & i).Value
wdApp.Selection.Style = wdApp.activedocument.Styles("Heading 3")
wdApp.Selection.TypeText Text:=strItemName
wdApp.Selection.InlineShapes.AddPicture FileName:=Excel.Sheets("Export").Range("a" & i).Text, LinkToFile:=False, SaveWithDocument:=True
If Excel.Sheets("Export").Range("a" & i).Value <> "" Then
wdApp.Selection.InlineShapes.AddPicture FileName:=Excel.Sheets("Export").Range("a" & i).Text, LinkToFile:=False, SaveWithDocument:=True
End If
wdApp.Selection.TypeParagraph
If Excel.Sheets("Export").Range("c" & i).Value > 1 Then
   strItemName = Excel.Sheets("Export").Range("c" & i).Value
   wdApp.Selection.Style = wdApp.activedocument.Styles("Body Text")
   wdApp.Selection.TypeText Text:=strItemName
   wdApp.Selection.TypeParagraph
End If
i = i + 1
Loop
wdApp.activedocument.ResizePic
wdApp.activedocument.AddPictureBox

The following subroutines are in the Word File

Sub ResizePic()
NumPic = ActiveDocument.InlineShapes.Count
For i = 1 To NumPic
origWidth = ActiveDocument.InlineShapes(i).Width
origHeight = ActiveDocument.InlineShapes(i).Height
scaleVal = (200 / origWidth)
With ActiveDocument.InlineShapes(i)
  .Height = origHeight * scaleVal
  .Width = origWidth * scaleVal
End With
Next i
End Sub


Sub AddPictureBox()
NumPic = ActiveDocument.InlineShapes.Count
Dim currentText As Variant
For i = 1 To NumPic
ActiveDocument.InlineShapes(1).Select
Selection.CreateTextbox
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 180
Selection.ShapeRange.Width = 200
Selection.ShapeRange.TextFrame.MarginLeft = 0
Selection.ShapeRange.TextFrame.MarginRight = 0
Selection.ShapeRange.TextFrame.MarginTop = 3.69
Selection.ShapeRange.TextFrame.MarginBottom = 3.69
Selection.ShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionLine
Selection.ShapeRange.Left = wdShapeRight
Selection.ShapeRange.Top = wdShapeTop
Selection.ShapeRange.LockAnchor = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = wdWrapSquare
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
'insert caption
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.TypeText Text:="Caption " & i
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("Caption")
Next I

The Excel code crashes at "wdApp.activedocument.AddPictureBox", and from what I can tell, the Word code crashes at "Selection.CreateTextbox"

I would appreciate any help.

mjf55 mjf55 · Accepted Answer · 2015-03-02T17:24:49

So, as a beginner myself, I do see 2 things.

missing End Sub statement at the bottom of AddPictureBox(). I assume that was a copy/paste issue.
this line: ActiveDocument.InlineShapes(1).Select , right under the start of the for loop, indexes 1 , and not i. Could that be the reason for it blowing up, possible on the second loop.

EDIT: So I placed ( one at a time ) a GIF, JPG and PNG in a word document. Stepping thru the code, I get a Runtime Error 5 Invalid procedure call or argument. This happens on this statement: Selection.ShapeRange.Fill.Visible = msoFalse

I may be going down a rabbit hole with the pictures I put in the word document, so I am bowing out. I suggest you step thru your code and see what statement you error on, and then google that for hints.

Good luck

This code "Selection.CreateTextbox" works in a word version 93-2001 file, but not in a word 2010 file

1 Answers