Cell border width replace globally using a macro

[Sam1085]

Hi everyone,

Some times I have to manually change 1/2pt width to 1pt (example only). So, I tried something to find and replace table cell borders width globally in my Word document.

I tried this:

Code: Select all

Private Sub cb_cmdOK_Click()
Application.ScreenUpdating = True
    Dim cbfind As Long, cbreplace As Long
    Dim myTable As Table, myRange As Range, myCell As Cell

    For Each myTable In ActiveDocument.Tables
        Set myRange = myTable.Range
        For Each myCell In myRange.Cells
            If myCell.Borders(wdBorderBottom).LineWidth = cbfind Then
               myCell.Borders(wdBorderBottom).LineWidth = cbreplace
            End If
        Next myCell
    Next myTable
Me.Hide
Application.ScreenUpdating = True
End Sub

I think something went wrong in above code. Can you guys help me to find a way to develop this code.

Another questions:
Is it possible to find and replace top/bottom/left/right cell borders using a simple code (current code return an error without "wdBorderBottom")?

Thank you!

[HansV]

You don't assign a value to cbfind and cbreplace.

If you want to set all four borders, you'll have to set each border separately. There is no way to do it in one go. You could do it like this. Declare an extra variable:

Code: Select all

    Dim myBorder As WdBorderType

and add a loop:

Code: Select all

        For Each myCell In myRange.Cells
            For myBorder = wdBorderRight To wdBorderTop
                If myCell.Borders(myBorder).LineWidth = cbfind Then
                   myCell.Borders(myBorder).LineWidth = cbreplace
                End If
            Next myBorder
        Next myCell

[HansV]

Are cbfind and cbreplace combo boxes on your userform? If so, you should delete the line

Code: Select all

    Dim cbfind As Long, cbreplace As Long

because that declaration makes cbfind and cbreplace local variables within the procedure. In other words, they won't refer to the combo boxes.

[Sam1085]

Thank you Hans for your quick response.

I think it's bit difficult to create and link combo boxes for each top/bottom/left/right borders.

However I have found another way to do that same thing.

Code: Select all

Sub Test()
Dim tbl As Table
Dim cel As Cell
Dim bord As Variant
Dim ln As Variant
    Application.ScreenUpdating = False
    bord = Array(wdBorderLeft, wdBorderTop, wdBorderRight, wdBorderBottom)
    For Each tbl In ActiveDocument.Tables
        For Each cel In tbl.Range.Cells
            For Each ln In bord
                If cel.Borders(ln).LineWidth = wdLineWidth100pt Then
                    cel.Borders(ln).LineWidth = wdLineWidth050pt
                End If
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub

URL: https://www.experts-exchange.com/questi ... rders.html" onclick="window.open(this.href);return false;

Now I only need to know how to connect wdLineWidth value with userform combo box.
I tried as follows. But it's not working:

Original Code

Code: Select all

                    If cel.Borders(ln).LineWidth = wdLineWidth050pt Then
                        cel.Borders(ln).LineWidth = wdLineWidth100pt
                    End If

Changed to this

Code: Select all

                    If cel.Borders(ln).LineWidth = Macros_Rep_TBL_Borders_Width.cbfind.Value Then
                        cel.Borders(ln).LineWidth = Macros_Rep_TBL_Borders_Width.cbreplace.Value
                    End If

Is it possible to connect "wdLineWidthXXXpt" directly to combo box?

Many Thanks!

[HansV]

Set the ColumnCount property of both combo boxes to 2, and the ColumnWidths property to 0.
Populate the combo boxes in the UserForm_Initialize event:

Code: Select all

Private Sub UserForm_Initialize()
    Dim v(1 To 9, 1 To 2)
    v(1, 1) = wdLineWidth025pt
    v(1, 2) = "0.25 point"
    v(2, 1) = wdLineWidth050pt
    v(2, 2) = "0.5 point"
    v(3, 1) = wdLineWidth075pt
    v(3, 2) = "0.75 point"
    v(4, 1) = wdLineWidth100pt
    v(4, 2) = "1 point"
    v(5, 1) = wdLineWidth150pt
    v(5, 2) = "1.5 point"
    v(6, 1) = wdLineWidth225pt
    v(6, 2) = "2.25 point"
    v(7, 1) = wdLineWidth300pt
    v(7, 2) = "3 point"
    v(8, 1) = wdLineWidth450pt
    v(8, 2) = "4.5 point"
    v(9, 1) = wdLineWidth600pt
    v(9, 2) = "6 point"
    Me.cbfind.List = v
    Me.cbreplace.List = v
End Sub

You should now be able to use the value of the combo boxes directly:

Code: Select all

                    If cel.Borders(ln).LineWidth = Me.cbfind.Value Then
                        cel.Borders(ln).LineWidth = Me.cbreplace.Value
                    End If

You may wish to check beforehand that the combo boxes aren't empty.

[Sam1085]

Thank you Hans for clear explanation. I will try this.

[Sam1085]

Hi Hans,

I tried as you mentioned above. But it's returned compile error. I'm using Word 2010 version. Any idea about this?



Thank you!

[HansV]

Is this a combo box on a userform?

[Sam1085]

oh.. I have deleted two combo boxes mistakenly.
Now everything working perfectly.

Thank you!

[Sam1085]

Hi Hans,

Some times this macro returning Run Time Error-5843. I'm Not sure what's the issue. As I tested this macro not working when find 0.25pt to replace some another value.
Could you please check?

Thank you!

[HansV]

It would be helpful if you attached a sample document for which the code fails.

[Sam1085]

Hi Hans,

Here is the code I tried:

Code: Select all

Private Sub UserForm_Initialize()
    Dim v(1 To 9, 1 To 2)
    v(1, 1) = wdLineWidth025pt
    v(1, 2) = "0.25 Point"
    v(2, 1) = wdLineWidth050pt
    v(2, 2) = "0.5 Point"
    v(3, 1) = wdLineWidth075pt
    v(3, 2) = "0.75 Point"
    v(4, 1) = wdLineWidth100pt
    v(4, 2) = "1 Point"
    v(5, 1) = wdLineWidth150pt
    v(5, 2) = "1.5 Point"
    v(6, 1) = wdLineWidth225pt
    v(6, 2) = "2.25 Point"
    v(7, 1) = wdLineWidth300pt
    v(7, 2) = "3 Point"
    v(8, 1) = wdLineWidth450pt
    v(8, 2) = "4.5 Point"
    v(9, 1) = wdLineWidth600pt
    v(9, 2) = "6 Point"
    Me.cbfind.List = v
    Me.cbreplace.List = v
End Sub

Private Sub Cancel_Click()
Me.Hide
End Sub

Private Sub cb_cmdOK_Click()
Dim tbl As Table
Dim cel As Cell
Dim bord As Variant
Dim ln As Variant
Application.ScreenUpdating = False
    bord = Array(wdBorderLeft, wdBorderTop, wdBorderRight, wdBorderBottom)
    For Each tbl In ActiveDocument.Tables
        For Each cel In tbl.Range.Cells
            For Each ln In bord
                If cel.Borders(ln).LineWidth = Me.cbfind.Value Then
                    cel.Borders(ln).LineWidth = Me.cbreplace.Value
                End If
            Next
        Next
    Next
Me.Hide
Application.ScreenUpdating = True
End Sub

Please see the attached document for example.

[HansV]

Please attach a .docm document with the code.

[Sam1085]

Hi Hans,
Please find the attached docm file:

Error returning when I try to find 0.25pt width to replace another (ex: 1pt) border width.
Thank you for help!

[HansV]

The code runs without error for me, but it doesn't do anything because as far as I can tell, none of the cells in your table have a border with line width 0.25.

[Sam1085]

Thank you Hans. I will check this with different version of Word.

[Sam1085]

Hi Hans,

I have tried this macro with 2016 Office version. It worked fine. But it's fully compatible to work with 2010 Office version.
I have recorded 2 minutes video.
https://drive.google.com/open?id=1Vqrvx ... YWdv8tr3GI" onclick="window.open(this.href);return false;

Any option to fix this issue?
Thank you!

[HansV]

I have no idea. wdLineWidth225pt = 18 should be valid in all versions of Word, not just Word 2016. See for example this page for Word 2003.

[Sam1085]

Thank you for information. I think it seems like Word 2010 bug.