0
我有一个Excel例程，用于将数据从Excel文件传输到Word文档中。该程序在将文件保存为Office 97-2003时起作用，但在将文件更新到Office 2010时崩溃。该问题涉及将文本框放在照片上并添加标题的编程部分。这部分编程从Excel中调用，但子例程在Word中。调整图像大小的子程序“ResizePic”有效，但子程序“AddPictureBox”不适用。有人可以向我提供可在Office 2010和2013中使用的代码。我不在乎它是否仍能在早期版本中使用。请注意，我最初并没有写这段代码，我也不是高级用户。只显示CreateDocumment子例程的相关部分。此代码“Selection.CreateTextbox”适用于单词版本93-2001文件，但不适用于单词2010文件
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
以下子程序是在Word中的“wdApp.activedocument.AddPictureBox”文件
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
Excel的代码崩溃，从我所知道的，码字的崩溃“的选择。 CreateTextbox“
我将不胜感激任何帮助。