excel vba 无法将模板转换为 word 文档

问题描述 投票:0回答:1

当我尝试生成 Word 文档时,进度条停在 80% 处,并显示以下错误。

当我尝试调试它时,我看到了这个

我现在遇到错误了

For i = 1 To .InlineShapes.Count

我的代码

Sub FillABookmark(strBM As String, strText As String)
    Dim j As Long
    With ActiveDocument
        .Bookmarks(strBM).Range _
        .InlineShapes _
        .AddPicture FileName:=strText
        j = ActiveDocument.InlineShapes.Count
        .InlineShapes(j).Select
        .Bookmarks.Add strBM, Range:=Selection.Range
    End With
End Sub


Sub AddImage(strFile As String, addOrAfter As Boolean)
 
 Dim oImage As Object
 'Dim oDialog As Dialog
 ' Dim oRng As Object
  '   Set oDialog = Dialogs(wdDialogInsertPicture)
   '  With oDialog
    '     .Display
     '    If .Name <> "" Then
      '       strFile = .Name
       '  End If
     'End With
    'Selection.Move 6, -1 'moverse al principio del documento
    'Selection.Find.Execute FindText:="[aud_sig_1]"
    'If Selection.Find.Found = True Then
    If (addOrAfter) Then


 Set oImage = Selection.InlineShapes.AddPicture(strFile, False, True)
 
 'With oRng
  '   .RelativeHorizontalPosition = _
   '  wdRelativeHorizontalPositionPage
    ' .RelativeVerticalPosition = _
    ' wdRelativeVerticalPositionPage
     '.Left = CentimetersToPoints(0)
     '.Top = CentimetersToPoints(4.5)
 'End With
 Else
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Set oImage = Selection.InlineShapes.AddPicture(strFile, False, True)
 End If
 With oImage
     .LockAspectRatio = msoFalse
     .Height = CentimetersToPoints(1.5)
     .Width = CentimetersToPoints(2.1)
     Set oRng = .ConvertToShape
 End With
 
 Set oDialog = Nothing
 Set oImage = Nothing
 Set oRng = Nothing

End Sub


Sub PicWithCaption(xPath, Optional ByVal imgType As String = "All")

Dim xFileDialog As FileDialog
Dim xFile As Variant


Dim doc As Document
'******Test
'Set doc = Application.ActiveDocument
 'xPath = "C:\phototest\"
'doc.Bookmarks.Exists ("photos")
'doc.Bookmarks("photos").Select                'select the bookmark
'*****End test

Dim x, w, c
Dim oTbl As Word.Table, i As Long, j As Long, k As Long, StrTxt As String


Set oTbl = Selection.Tables.Add(Selection.Range, 2, 3)

With oTbl
            .AutoFitBehavior (wdAutoFitFixed)
            .Columns.Width = CentimetersToPoints(9)
            'Format the rows
            Call FormatRows(oTbl, 1)
End With

    If xPath <> "" Then
        xFile = Dir(xPath & "\*.*")
        i = 1
        CaptionLabels.Add Name:="Picture"
         Do While xFile <> ""
            If (UCase(Right(xFile, 3)) = "PNG" Or _
                UCase(Right(xFile, 3)) = "TIF" Or _
                UCase(Right(xFile, 3)) = "JPG" Or _
                UCase(Right(xFile, 3)) = "GIF" Or _
                UCase(Right(xFile, 3)) = "BMP") And (imgType = "All" Or UCase(Left(xFile, 1) <> imgType)) Then

                 j = Int((i + 2) / 3) * 2 - 1
                k = (i - 1) Mod 3 + 1
                'Add extra rows as needed
                If j > oTbl.Rows.Count Then
                    oTbl.Rows.Add
                    oTbl.Rows.Add
                    Call FormatRows(oTbl, j)
                End If
            'Insert the Picture
            'Dim shape  As InlineShape
            ' ActiveDocument.InlineShapes.AddPicture _
             '   FileName:=xPath & "\" & xFile, LinkToFile:=False, _
              '  SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
                
            Set shape = ActiveDocument.InlineShapes.AddPicture(xPath & "\" & xFile, False, True, oTbl.Rows(j).Cells(k).Range)
            oTbl.Rows(j).Cells(k).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            
            
           ' With shape
             '  .LockAspectRatio = msoTrue
              ' If .Width > .Height Then
             '  .Height = InchesToPoints(1.75)
             '  Else
             '    .Width = InchesToPoints(1.75)
              '   End If
             '   End With
               
            'shape.ScaleWidth = 50
                
            'Get the Image name for the Caption
            'StrTxt = Split(xPath & "\" & xFile, "\")(UBound(Split(.SelectedItems(i), "\")))
            StrTxt = xFile
            StrTxt = ": " & Split(StrTxt, ".")(0)
            'Insert the Caption on the row below the picture
              With oTbl.Rows(j + 1).Cells(k).Range
                .InsertBefore vbCr
                .Characters.First.InsertParagraph
                 .InsertBefore StrTxt
                 .ParagraphFormat.Alignment = wdAlignParagraphCenter
                 .Font.Bold = True
                .Characters.First = vbNullString
                .Characters.Last.Previous = vbNullString
              End With
           End If
           i = i + 1
           xFile = Dir()
              Loop
        End If
'End If
End Sub

Sub FormatRows(oTbl As Table, x As Long)
    With oTbl
        With .Rows(x)
            .Height = CentimetersToPoints(6)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Normal"
            .Alignment = wdAlignRowCenter
            End With
        With .Rows(x + 1)
            .Height = CentimetersToPoints(1.2)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Caption"
            .Alignment = wdAlignRowCenter
        End With
    End With
End Sub

Sub rezie()
Dim i As Long
With ThisDocument
 For i = 1 To .InlineShapes.Count
 Next i
 End With

End Sub
excel vba ms-word
1个回答
1
投票

在非英语系统上使用样式枚举是安全的:

.Range.Style = Word.wdStyleCaption
(如果您使用早期绑定 - 您正在使用的内容)

如果晚绑定:

.Range.style = -35

© www.soinside.com 2019 - 2024. All rights reserved.