View Single Post
 
Old 09-11-2022, 04:13 AM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

You could employ a simple userform with two listboxes and a command button. Let prone to user errors:

Code:
Option Explicit
Private Sub UserForm_Initialize()
 With ListBox1
   .AddItem
   .List(.ListCount - 1, 0) = "0.25 pt"
   .List(.ListCount - 1, 1) = 2
   .AddItem
   .List(.ListCount - 1, 0) = "0.50 pt"
   .List(.ListCount - 1, 1) = 4
   .AddItem
   .List(.ListCount - 1, 0) = "0.75 pt"
   .List(.ListCount - 1, 1) = 6
   .AddItem
   .List(.ListCount - 1, 0) = "1 pt"
   .List(.ListCount - 1, 1) = 8
   .AddItem
   .List(.ListCount - 1, 0) = "1.5 pt"
   .List(.ListCount - 1, 1) = 12
   .AddItem
   .List(.ListCount - 1, 0) = "2.25 pt"
   .List(.ListCount - 1, 1) = 18
   .AddItem
   .List(.ListCount - 1, 0) = "3.00 pt"
   .List(.ListCount - 1, 1) = 24
   .AddItem
   .List(.ListCount - 1, 0) = "4.5 pt"
   .List(.ListCount - 1, 1) = 36
   .AddItem
   .List(.ListCount - 1, 0) = "6 pt"
   .List(.ListCount - 1, 1) = 48
   .ListIndex = 3
  End With
  With ListBox2
    .List = ListBox1.List
    .ListIndex = 5
  End With
lbl_Exit:
  Exit Sub
End Sub

Private Sub CommandButton1_Click()
Dim oTbl As Table
  For Each oTbl In ActiveDocument.Tables
    oTbl.Rows.Last.Range.Select
    With Selection.Range
      With .Borders(wdBorderTop)
        .LineStyle = wdLineStyleSingle
        .LineWidth = ListBox1.Column(1)
        .Color = wdColorAutomatic
      End With
      With .Borders(wdBorderBottom)
        .LineStyle = wdLineStyleSingle
        .LineWidth = ListBox2.Column(1)
        .Color = wdColorAutomatic
      End With
    End With
  Next oTbl
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote