Macro to remove cell border
Macro to remove cell border
Macro to remove cell border
Macro to remove cell border
Macro to remove cell border
Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border
Macro to remove cell border Macro to remove cell border
Macro to remove cell border
Go Back  Xtreme Visual Basic Talk > > > > Macro to remove cell border


Reply
 
Thread Tools Display Modes
  #1  
Old 08-21-2016, 03:51 PM
jim77 jim77 is offline
Newcomer
 
Join Date: Aug 2016
Posts: 8
Default Macro to remove cell border


Hello,
I have the following macro in Word and can not figure out how to remove the cell border above the row with the caption. (see screenshot). The image is on row 1 and the caption on row 2. I do not want a border between those 2 cells.
Code:
Sub AddPics()
    Selection.MoveDown Unit:=wdLine, Count:=1
    Application.ScreenUpdating = False
    Dim oTbl As Table, i As Long, j As Long, StrTxt As String
     '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
             'Add a 2-row by 1-column table with 7cm column width to take the images
            Set oTbl = Selection.Tables.Add(Selection.Range, 2, 1)
            'Add a 2-row by 3-column table with 7cm column width to take the images
            'Set oTbl = Selection.Tables.Add(Selection.Range, 2, 3)
                With Selection.Tables(1)
                    With .Borders(wdBorderLeft)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorAutomatic
                    End With
                    With .Borders(wdBorderRight)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorAutomatic
                    End With
                    With .Borders(wdBorderTop)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorAutomatic
                    End With
                    With .Borders(wdBorderBottom)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorAutomatic
                    End With
                    With .Borders(wdBorderHorizontal)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        'make this white
                        .Color = wdColorAutomatic
                    End With
                    With .Borders(wdBorderVertical)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorAutomatic
                    End With
                        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
                        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
                        .Borders.Shadow = False
                    End With
                    With Options
                        .DefaultBorderLineStyle = wdLineStyleDashLargeGap
                        .DefaultBorderLineWidth = wdLineWidth050pt
                        .DefaultBorderColor = wdColorAutomatic
                    End With
            With oTbl
                .AutoFitBehavior (wdAutoFitFixed)
                '.Columns.Width = CentimetersToPoints(7)
                .Columns.Width = CentimetersToPoints(6)
                 'Format the rows
                Call FormatRows(oTbl, 1)
            End With
            CaptionLabels.Add Name:="Picture"
            For i = 1 To .SelectedItems.Count
                j = i * 2 - 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
                ActiveDocument.InlineShapes.AddPicture _
                FileName:=.SelectedItems(i), LinkToFile:=False, _
                SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(1).Range
                With Selection.Cells
                    With .Borders(wdBorderTop)
                    .LineStyle = wdLineStyleDashLargeGap
                    .LineWidth = wdLineWidth050pt
                    .Color = wdColorAutomatic
                    End With
                End With
                 'Get the Image name for the Caption
                StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
                StrTxt = ": " & Split(StrTxt, ".")(0)
                 'Insert the Caption on the row below the picture
                With oTbl.Rows(j + 1).Cells(1).Range
                    .InsertBefore vbCr
                    .Characters.First.InsertCaption _
                    Label:="Picture", Title:=StrTxt, _
                    Position:=wdCaptionPositionBelow, ExcludeLabel:=False
                    .Characters.First = vbNullString
                    .Characters.Last.Previous = vbNullString
                    'add top white border here
                    With .Borders(wdBorderBottom)
                        .LineStyle = wdLineStyleDashLargeGap
                        .LineWidth = wdLineWidth050pt
                        .Color = wdColorBlack
                    End With
                End With
            Next
        Else
        End If
    End With
    Application.ScreenUpdating = True
    
End Sub
Sub FormatRows(oTbl As Table, x As Long)
    With oTbl
        With .Rows(x)
            .Height = CentimetersToPoints(2.5)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Normal"
        End With
        With .Rows(x + 1)
            .Height = CentimetersToPoints(0.75)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Caption"
        End With
    End With
End Sub
Thanks
Attached Images
File Type: jpg screenshot.jpg (57.5 KB, 0 views)
Reply With Quote
  #2  
Old 08-22-2016, 05:45 AM
jim77 jim77 is offline
Newcomer
 
Join Date: Aug 2016
Posts: 8
Default Solved

I resolved it by adding this at the end.
Code:
Sub ModifyActiveTable()
Dim i As Long
With Selection
  If .Information(wdWithInTable) = False Then Exit Sub
  With .Tables(1)
      'Restore borders to every 2nd row
      If i Mod 2 = 0 Then
        With .Rows(i).Cells
          .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        End With
      End If
    Next
  End With
End With
End Sub
Reply With Quote
Reply

Tags
wdlinewidth050pt, wdlinestyledashlargegap, .linewidth, wdcolorautomatic, .linestyle, .color, otbl, caption, table, add, border, row, formatrowsotbl, insert, image, strtxt, .borderswdbordertop, rows, .borderswdborderbottom, picture, otbl.rows.add, wdlinestylenone, white, 2-row, images


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
Macro to remove cell border
Macro to remove cell border
Macro to remove cell border Macro to remove cell border
Macro to remove cell border
Macro to remove cell border
Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border Macro to remove cell border
Macro to remove cell border
Macro to remove cell border
 
Macro to remove cell border
Macro to remove cell border
 
-->