View Single Post
 
Old 08-11-2022, 02:40 AM
AlexOfRhodes AlexOfRhodes is offline Windows 10 Office 2019
Novice
 
Join Date: Aug 2022
Posts: 2
AlexOfRhodes is on a distinguished road
Default Error with the .Styles("Caption").ParagraphFormat.KeepWithNext

Hi, I also have the error on the .Styles("caption")... line when trying to add the caption above the picture, as another user.
I placed it as per the instructions in post #2.
Anyone can point out what i'm doing wrong?
(It works perfectly when addin the caption below the image)

Code:
Sub AddImageTable()
    'Sourced from: https://www.msofficeforums.com/47919-post2.html
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long, iShp As InlineShape
    Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single, ColWdth As Single
    On Error GoTo ErrExit
    NumCols = oColumnsCount.Value 'CLng(InputBox("How Many Columns per Row?"))
'    RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in Centimeters (e.g. 5)?")))
    RwHght = CentimetersToPoints(CSng(oRowsHeight.Value))
    On Error GoTo 0
    
    'Select and insert the Pics
    With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "Select image files and click OK"
      .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
      .FilterIndex = 2
      
      If .Show = -1 Then
        'Create a paragraph Style with 0 space before/after & centre-aligned
        On Error Resume Next
        
        With ActiveDocument
          .Styles.Add Name:="TblPic", Type:=wdStyleTypeParagraph
          On Error GoTo 0
          
          With .Styles("TblPic").ParagraphFormat
            .Alignment = wdAlignParagraphCenter
            
            'Insert caption below (true) or above (false) the picture
            .KeepWithNext = oCaptionsBelowImage.Value
            .SpaceAfter = 0
            .SpaceBefore = 0
          End With
        End With
        
        'Add a 2-row by NumCols-column table to take the images
        Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
        With ActiveDocument.PageSetup
          TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
          ColWdth = TblWdth / NumCols
        End With
        
        With oTbl
          .AutoFitBehavior (wdAutoFitFixed)
          .TopPadding = 0
          .BottomPadding = 0
          .LeftPadding = 0
          .RightPadding = 0
          .Spacing = 0
          .Columns.Width = ColWdth
          .Borders.Enable = oShowBorders.Value
        End With
        
        CaptionLabels.Add Name:="Picture"
        
        'ERROR next line: .styles : method or data member not found
        .Styles("Caption").ParagraphFormat.KeepWithNext = Not oCaptionsBelowImage.Value 'True To insert the captions above the pictures
        
        For i = 1 To .SelectedItems.Count Step NumCols
          r = ((i - 1) / NumCols + 1) * 2 - 1
          
          'Format the rows
          Call FormatRows(oTbl, r, RwHght)
          
          For c = 1 To NumCols
            j = j + 1
            
            'Insert the Picture
            Set iShp = ActiveDocument.InlineShapes.AddPicture( _
              FileName:=.SelectedItems(j), LinkToFile:=oLinkToFile.Value, _
              SaveWithDocument:=True, Range:=oTbl.Cell(r + IIf(oCaptionsBelowImage.Value = True, 0, 1), c).Range)
              'SaveWithDocument:=True, Range:=oTbl.Cell(r , c).Range 'To insert the captions below the pictures
              'SaveWithDocument:=True, Range:=oTbl.Cell(r + 1, c).Range 'To insert the captions above the pictures
            
            With iShp
              .LockAspectRatio = True
              If (.Width < ColWdth) And (.Height < RwHght) Then
                .Width = ColWdth
                If .Height > RwHght Then .Height = RwHght
              End If
            End With
            
            'Get the Image name for the Caption
            StrTxt = Split(.SelectedItems(j), "\")(UBound(Split(.SelectedItems(j), "\")))
            StrTxt = ": " & Split(StrTxt, ".")(0)
            
            'Insert the Caption on the row below the picture
            With oTbl.Cell(r + IIf(oCaptionsBelowImage.Value = True, 1, 0), c).Range
            'With oTbl.Cell(r + 1, c).Range 'To insert the captions below the pictures
            'With oTbl.Cell(r, c).Range 'To insert the captions above the pictures
            
              .InsertBefore vbCr
              .Characters.First.InsertCaption _
              Label:="Picture", Title:=StrTxt, _
              Position:=wdCaptionPositionBelow, ExcludeLabel:=False
              .Characters.First = vbNullString
              .Characters.Last.Previous = vbNullString
              
              'or without Label:
              'oTbl.Cell(r + 1, c).Range.Text =StrTxt
              
              
            'To prevent overly-long captions wrapping:
            If oShrinkCaptions.Value = True Then
                If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
                  .Characters.First.Information(wdVerticalPositionRelativeToPage) Then
                  .FitTextWidth = ColWdth
                End If
            End If
    
            End With
            
            'Exit when we're done
            If j = .SelectedItems.Count Then Exit For
          Next
          
          'Add extra rows as needed
          If j < .SelectedItems.Count Then
            oTbl.Rows.Add
            oTbl.Rows.Add
          End If
        Next
        
        If oConvertTableToText.Value = True Then oTbl.ConvertToText
      Else
      End If
    End With
ErrExit:
    Application.ScreenUpdating = True
End Sub

Sub FormatRows(oTbl As Table, x As Long, Hght As Single)
    With oTbl
      With .Rows(x + IIf(oCaptionsBelowImage.Value = True, 0, 1))
      'With .Rows(x) 'To insert the captions below the pictures
      'With .Rows(x + 1) 'To insert the captions above the pictures
        .Height = Hght
        .HeightRule = wdRowHeightExactly
        .Range.Style = "TblPic"
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter
      End With
'      With .Rows(x + 1)
      With .Rows(x + IIf(oCaptionsBelowImage.Value = True, 1, 0))
        .Height = CentimetersToPoints(0.5)
        .HeightRule = wdRowHeightExactly
        .Range.Style = "Caption"
      End With
    End With
End Sub
Reply With Quote