Question

我试图写一个小的VBA-Macro，用一堆图片（> 100）整理一个巨大的word文件，确保它们都是正常形状（不是内联）并且有一个标题相关联跟他们。此外，标题和图片需要组合在一起，以便更容易地重新安排它们。

但是在运行代码时遇到了问题。创建一个＆＃34; shaperange＆＃34; ＆＃34;组＆＃34;方法崩溃（Set shpGroup = ShpRng.Group）时出现运行时错误＆＃34;＆＃39; -2147024891（8000700005）＆＃39;：已禁用所选表单的分组＆＃34;

这是我的代码：

Sub PicFix()
'
' For a selected picture, convert it to a normal image (not inline),
' add acaption to it, then group the image and its caption
'
    Dim sCaption As String
    Dim shpIn As InlineShape
    Dim shpPic, shpCap, shpGroup  As Shape
    Dim ShpRng As ShapeRange
    Dim sNamePic, sNameCap As String
    Dim iZOrder As Integer

'First of all get hold of the shape and assign it to the SHP object
' In case it is an inline shape, converted to a normal shape
    If Selection.InlineShapes.Count > 0 Then
        Set shpIn = Selection.InlineShapes(1)
        Set shpPic = shpIn.ConvertToShape
    Else
        Set shpPic = Selection.ShapeRange(1)
    End If

' Second, fetch the caption text from the clipboard
    ' sCaption = GetClipBoardText()
    ' For debugging purpose....
       sCaption = "This is a dummy caption" ' Just assign a dummy caption string


' now  start to "fix" the selected picture...
shpPic.Select
iZOrder = shpPic.ZOrderPosition
sNamePic = "Pic_" + CStr(iZOrder)
shpPic.Name = sNamePic  ' Give this object a name. Use the ZOrderPosition as a name as it is unique within the documnet
                        ' (but might change as new shapes etc. are addedd to the document - but, best I can do)
shpPic.WrapFormat.Type = wdWrapSquare ' Make the text wraps around all sides

If sCaption > "" Then
    shpPic.Select ' make sure the picture is selected before adding the caption below it
    Selection.InsertCaption Label:="Figure", TitleAutoText:="", Title:=": " + sCaption, Position:=wdCaptionPositionBelow

    ' Now the selected object has changed from the picture to the new caption
    Set shpCap = Selection.ShapeRange(1)
    sNameCap = "Cap_" + CStr(iZOrder)       ' Give the caption object a name as well
    shpCap.Name = sNameCap

    Debug.Print "ShapeNames: shpPic=" + shpPic.Name + "; shpCap=" + shpCap.Name
    Debug.Print "ShapeTypes: shpPic=" + CStr(shpPic.Type) + "; shpCap=" + CStr(shpCap.Type) ' 13=Picture; 17=TextBox

    ' Here is the tricky bit ... group the picture and its caption ...
    ' create a shaperange containing the two objects, then group them
    Set ShpRng = ActiveDocument.Shapes.Range(Array(sNamePic, sNameCap))

    Set shpGroup = ShpRng.Group ' <<<<------ This is where it crashes :
                                '               runtime Error: Grouping of selected objects (or forms) is disabled

    shpGroup.Select ' Make sure it is selected
    shpGroup.WrapFormat = wdWrapSquare ' Make the text wraps around all sides
End If

End Sub

知道我做错了吗？

Answer 1

问题与选择的标题有关（或在编辑模式或其他情况下）。

您可以通过在问题代码之前选择其他内容来解决此问题。

' Following added to workaround error when caption is selected.
shpPic.Select
Set shpGroup = ShpRng.Group ' <<<<------ This is where it crashes :

请注意，解决此问题后，最后一行会出现错误。你应该把它改成：

shpGroup.WrapFormat.Type = wdWrapSquare ' Make the text wraps around all sides

使用VBA脚本在MS-Word 2010中对形状进行分组时出现运行时错误

1 个答案: