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「
我將不勝感激任何幫助。