Help with Borderrs and Shading Dialog

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Mon, 11 Aug 2008 11:50:51


I am trying to return the value of user settings in the Borders and Shading
dialog. I can determine the Left, Right, Top, Bottom, Horizontal, and
Vertical border styles selected an then use that information later on to set
one or more table borders. What I can't figure out is how to determine the
line color and line width that a user selects.

Here is simplified version of my overall code that shows how I can get the
border style choosen in the dialog. I just can't figure out how to return
the user selected line width or color.

Thanks.


Sub Test()
Dim LS As Long
Dim RS As Long
Dim TS As Long
Dim BS As Long
Dim VS As Long
Dim HS As Long
Dim Color '????????????
Dim LineWidth '?????????????
With Dialogs(wdDialogFormatBordersAndShading)
If .Display <> 0 Then
LS = .Leftstyle
RS = .RightStyle
TS = .TopStyle
BS = .BottomStyle
HS = .HorizStyle
VS = .VertStyle
Color = ??????????????
LindeWidth = ?????????????
End If
End With
With Selection.Tables(1)
With .Borders(wdBorderLeft)
.LineStyle = LS
.LineWidth = wdLineWidth050pt 'Replace this with LineWidth selected by
user
.Color = wdColorRed 'Replace this with Color selected by user
End With
End With
End Sub

--
Greg Maxey - Word MVP

My web site http://www.yqcomputer.com/
Word MVP web site http://www.yqcomputer.com/
 
 
 

Help with Borderrs and Shading Dialog

Post by Graham May » Mon, 11 Aug 2008 15:04:06

ow about

Dim BLStyle As String
Dim BLWidth As String
Dim BLColor As String
Dim BRStyle As String
Dim BRWidth As String
Dim BRColor As String
Dim BTStyle As String
Dim BTWidth As String
Dim BTColor As String
Dim BBStyle As String
Dim BBWidth As String
Dim BBColor As String
Dim BHStyle As String
Dim BHWidth As String
Dim BHColor As String
Dim BVStyle As String
Dim BVWidth As String
Dim BVColor As String
Dim BDStyle As String
Dim BUStyle As String
Dim BShadow As Boolean

With Selection.Tables(1)
With .Borders(wdBorderLeft)
BLStyle = .LineStyle
BLWidth = .LineWidth
BLColor = .Color
End With
With .Borders(wdBorderRight)
BRStyle = .LineStyle
BRWidth = .LineWidth
BRColor = .Color
End With
With .Borders(wdBorderTop)
BTStyle = .LineStyle
BTWidth = .LineWidth
BTColor = .Color
End With
With .Borders(wdBorderBottom)
BBStyle = .LineStyle
BBWidth = .LineWidth
BBColor = .Color
End With
With .Borders(wdBorderHorizontal)
BHStyle = .LineStyle
BHWidth = .LineWidth
BHColor = .Color
End With
With .Borders(wdBorderVertical)
BVStyle = .LineStyle
BVWidth = .LineWidth
BVColor = .Color
End With
BDStyle = .Borders(wdBorderDiagonalDown).LineStyle
BUStyle = .Borders(wdBorderDiagonalUp).LineStyle
BShadow = .Borders.Shadow
End With
MsgBox BLStyle & vbCr & _
BLWidth & vbCr & _
BLColor & vbCr & _
BRStyle & vbCr & _
BRWidth & vbCr & _
BRColor & vbCr & _
BTStyle & vbCr & _
BTWidth & vbCr & _
BTColor & vbCr & _
BBStyle & vbCr & _
BBWidth & vbCr & _
BBColor & vbCr & _
BHStyle & vbCr & _
BHWidth & vbCr & _
BHColor & vbCr & _
BVStyle & vbCr & _
BVWidth & vbCr & _
BVColor & vbCr & _
BDStyle & vbCr & _
BUStyle & vbCr & _
BShadow

?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Greg Maxey wrote:



 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Mon, 11 Aug 2008 15:21:43

have found most of the solution myself through trial and error and using
VBA help file. The ultimate goal is to create a macro that will apply
common borders and shading to all tables in a documnet. Lene Fredborg is
part of the code looks familiar it is because I got the idea after looking
at your web article on apply common borders.

I learned that the values returned by the dialog for border line weights and
shading texture do not convert directly to linewidths and texture in the
table oject. I had to use a function to convert these to values the table
object would use. Another thing that I was not able to work out is it seems
that ther is no way to convert the .shading value returned for some of the
textures: e.g., 12.5%, 15%, 35%, 37.5% ect. All of these return a value
of -1.

If anyone can see a way to get a useful return for the texture values
mentioned above please let me know.

Thanks.

Public Sub ApplyUniformBordersAndShadingToAllTables()
Dim oTables As Tables
Dim oTable As Table
Dim Title As String
Dim n As Long
Dim i As Long
Dim Shading
Dim TopStyle As Long
Dim LeftStyle As Long
Dim BottomStyle As Long
Dim RightStyle As Long
Dim HorizStyle As Long
Dim VertStyle As Long
Dim TopWeight As Long
Dim LeftWeight As Long
Dim BottomWeight As Long
Dim RightWeight As Long
Dim HorizWeight As Long
Dim VertWeight As Long
Dim BorderObjectType
Dim BorderArtWeight
Dim BorderArt
Dim ForegroundRGB
Dim BackgroundRGB
Dim TopColorRGB
Dim LeftColorRGB
Dim BottomColorRGB
Dim RightColorRGB
Dim HorizColorRGB
Dim VertColorRGB
Set oTables = ActiveDocument.Tables
Title = "Apply Uniform Borders to All Tables"
If Not Selection.Information(wdWithInTable) Then oTables(1).Select
If oTables.Count > 0 Then
If MsgBox("This command applies uniform table borders " & _
"to all tables in the active document." & vbCr & vbCr & _
"Do you want to continue?", vbQuestion + vbYesNo, Title) = vbYes
Then
Err_ReEntry:
With Dialogs(wdDialogFormatBordersAndShading)
If .Display <> 0 Then
Shading = ConvertShading(.Shading)
On Error GoTo Error_Handler
If Shading = "No VBA conversion" Then
Err.Raise vbObjectError + 1
End If
ForegroundRGB = .ForegroundRGB
BackgroundRGB = .BackgroundRGB
LeftStyle = .LeftStyle
RightStyle = .RightStyle
TopStyle = .TopStyle
BottomStyle = .BottomStyle
HorizStyle = .HorizStyle
VertStyle = .VertStyle
TopColorRGB = .TopColorRGB
LeftColorRGB = .LeftColorRGB
BottomColorRGB = .BottomColorRGB
RightColorRGB = .RightColorRGB
HorizColorRGB = .HorizColorRGB
VertColorRGB = .VertColorRGB
TopWeight = ConvertWeight(.TopWeight)
LeftWeight = ConvertWeight(.LeftWeight)
BottomWeight = ConvertWeight(.BottomWeight)
RightWeight = ConvertWeight(.RightWeight)
HorizWeight = ConvertWeight(.HorizWeight)
VertWeight = ConvertWeight(.VertWeight)
End If
End With
For Each oTable In oTables
'Count tables - used in message
n = n + 1
With oTable
With .Shading
.ForegroundPatternColor = ForegroundRGB
.BackgroundPatternColor = BackgroundRGB
.Texture = Shading
End With
On Error Resume Next
With .Borders(wdBorderLeft)
.LineStyle = LeftSty
 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Mon, 11 Aug 2008 15:36:18

raham,

We all know that I have a problem with simple English and my initial
question was probably poorly written. I was trying to get the values from
the BordersAndShading dialog that corresponded to the values used to format
borders and shading with VBA. I think you will see what I was trying to do
by looking at the code in my second post.

Thanks anyway.




Graham Mayor wrote:

--
Greg Maxey - Word MVP

My web site http://gregmaxey.mvps.org
Word MVP web site http://word.mvps.org


 
 
 

Help with Borderrs and Shading Dialog

Post by Tony Jolla » Mon, 11 Aug 2008 23:28:14

Hi Greg,

.LineColorRGB gives the colour.I don't think the width is available.

However, the values in the dropdowns only really have meaning within the
dialog - once chosen they must be applied to individual borders, and each
may have a different value - which you already seem to be picking up.

--
Enjoy,
Tony
 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Mon, 11 Aug 2008 23:41:16

Tony,

I found a way to get width. It is the TopWeight, LeftWeight, etc. argument
of the dialog, but it has to be converted to a meaningful value to apply as
a line width.

Thanks.




--
Greg Maxey - Word MVP

My web site http://www.yqcomputer.com/
Word MVP web site http://www.yqcomputer.com/
 
 
 

Help with Borderrs and Shading Dialog

Post by Jay Freedm » Tue, 12 Aug 2008 01:59:47

i Greg,

I see you found a way to convert the line weights from the dialog to the values
you need. If you're interested in something a little simpler and more
understandable, here's an explanation.

The values you get from the dialog are, of course, just the index of the
selection in the dropdown. The values you need to set the Borders properties are
members of the WdLineWidth collection. If you look up that collection in the
Object Browser, they're a strange sequence (2, 4, 6, 8, 12, 18, 24, 36, 48). But
they have mnemonic names so you don't have to know the actual values.

So if you initialize an array with the names corresponding to what you see in
the dialog dropdown, then you can get the proper value by using the dialog
return value as an index into that array:

Dim LineWeights()
LineWeights = Array( _
wdLineWidth025pt, wdLineWidth050pt, _
wdLineWidth075pt, wdLineWidth100pt, _
wdLineWidth150pt, wdLineWidth225pt, _
wdLineWidth300pt, wdLineWidth450pt, _
wdLineWidth600pt)

TopWeight = LineWeights(.TopWeight)
' etc.

There's probably something similar for converting the shading, but I haven't
looked at it yet.

On Sun, 10 Aug 2008 02:21:43 -0400, "Greg Maxey"
< XXXX@XXXXX.COM > wrote:

 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Tue, 12 Aug 2008 02:54:22

ay,

Yes you are right. You can get most of the shading selections into an array,
but several of them return -1 rather than the expected sequence in the list.
Because of that I still need to use a function.

I think my next step is to see if I can actually format the tables using
another instance of the dialog rather than using the table object. Seems I
should be able to set the values of the dialog based on the intial user
selection and then .execute.



Public Sub ApplyUniformBordersAndShadingToAllTables()
Dim oTables As Tables
Dim oTable As Table
Dim Title As String
Dim n As Long
Dim i As Long
Dim Shading
Dim Shadow
Dim TopStyle As Long
Dim LeftStyle As Long
Dim BottomStyle As Long
Dim RightStyle As Long
Dim HorizStyle As Long
Dim VertStyle As Long
Dim TL2BRStyle As Long, TR2BLStyle As Long
Dim TopWeight As Long
Dim LeftWeight As Long
Dim BottomWeight As Long
Dim RightWeight As Long
Dim HorizWeight As Long
Dim VertWeight As Long
Dim TL2BRWeight As Long, TR2BLWeight As Long
Dim ForegroundRGB
Dim BackgroundRGB
Dim TopColorRGB
Dim LeftColorRGB
Dim BottomColorRGB
Dim RightColorRGB
Dim HorizColorRGB
Dim VertColorRGB
Dim TL2BRColorRGB, TR2BLColorRGB
Dim LineWeights()
'Dim Shading()
On Error Resume Next
Set oTables = ActiveDocument.Tables
On Error GoTo 0
Title = "Apply Uniform Borders to All Tables"
If Not Selection.Information(wdWithInTable) Then oTables(1).Select
If oTables.Count > 0 Then
If MsgBox("This command applies uniform table borders " & _
"to all tables in the active document." & vbCr & vbCr & _
"Do you want to continue?", vbQuestion + vbYesNo, Title) = vbYes
Then
LineWeights = Array(wdLineWidth025pt, wdLineWidth050pt, _
wdLineWidth075pt, wdLineWidth100pt, _
wdLineWidth150pt, wdLineWidth225pt, _
wdLineWidth300pt, wdLineWidth450pt, _
wdLineWidth600pt)
Err_ReEntry:
With Dialogs(wdDialogFormatBordersAndShading)
If .Display <> 0 Then
Shadow = .Shadow
Shading = ConvertShading(.Shading)
On Error GoTo Error_Handler
If Shading = "No VBA conversion" Then
Err.Raise vbObjectError + 1
End If
ForegroundRGB = .ForegroundRGB
BackgroundRGB = .BackgroundRGB
LeftStyle = .LeftStyle
RightStyle = .RightStyle
TopStyle = .TopStyle
BottomStyle = .BottomStyle
HorizStyle = .HorizStyle
VertStyle = .VertStyle
TL2BRStyle = .TL2BRStyle
TR2BLStyle = .TR2BLStyle
TopColorRGB = .TopColorRGB
LeftColorRGB = .LeftColorRGB
BottomColorRGB = .BottomColorRGB
RightColorRGB = .RightColorRGB
HorizColorRGB = .HorizColorRGB
VertColorRGB = .VertColorRGB
TL2BRColorRGB = .TL2BRColorRGB
TR2BLColorRGB = .TR2BLColorRGB
TopWeight = LineWeights(.TopWeight)
LeftWeight = LineWeights(.LeftWeight)
BottomWeight = LineWeights(.BottomWeight)
RightWeight = LineWeights(.RightWeight)
HorizWeight = LineWeights(.HorizWeight)
VertWeight = LineWeights(.VertWeight)
On Error Resume Next
TL2BRWeight = LineWeights(.TL2BRWeight)
TR2BLWeight = LineWeights(.TR2BLWeight)
On Error GoTo 0
End If
End With
For Each oTable In oTables
Application.ScreenRefresh
'Count tables
 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Tue, 12 Aug 2008 06:30:56

ay,

There is definately some disconnect between the BuiltInDialog texture list
selection and what gets applied as shading in the table. Most of the
choices in the list return a positive sequential number, but several 12.5%,
15%, 35%, 45% etc. all return -1. Accrodingly I am using a combination of
an Array with most of the values and a Select Case statement to provide the
rstin in a Function. As a result of this, I was not able to make full use
of the built in dialog to actually reformat each table. If any of those
choice that return -1 are selected then the shading becomes solid 100%.
Below is the complete code that seems to be working correctly in Word2003.
I have left in the statements (commented out) where I tried to use the
Dialog a second time to actually format the tables. I you have time and
interest then maybe you can see something that I was doing wrong.

Thanks.

Public Sub ApplyUniformBordersAndShadingToAllTables()
Dim oTables As Tables
Dim oTable As Table
Dim Title As String
Dim n As Long, i As Long
Dim Shading, Shadow
Dim TopStyle As Long, LeftStyle As Long, BottomStyle As Long
Dim RightStyle As Long, HorizStyle As Long, VertStyle As Long
Dim TL2BRStyle As Long, TR2BLStyle As Long
Dim TopWeight As Long, LeftWeight As Long, BottomWeight As Long
Dim RightWeight As Long, HorizWeight As Long, VertWeight As Long
Dim TL2BRWeight As Long, TR2BLWeight As Long
Dim ForegroundRGB, BackgroundRGB
Dim TopColorRGB, LeftColorRGB, BottomColorRGB
Dim RightColorRGB, HorizColorRGB, VertColorRGB
Dim TL2BRColorRGB, TR2BLColorRGB
Dim LineWeights()
On Error Resume Next
Set oTables = ActiveDocument.Tables
On Error GoTo 0
Title = "Apply Uniform Borders to All Tables"
If Not Selection.Information(wdWithInTable) Then oTables(1).Select
If oTables.Count > 0 Then
If MsgBox("This command applies uniform table borders and shading " & _
"to all tables in the active document." & vbCr & vbCr & _
"Do you want to continue?", vbQuestion + vbYesNo, Title) = vbYes
Then
LineWeights = Array(wdLineWidth025pt, wdLineWidth050pt, _
wdLineWidth075pt, wdLineWidth100pt, _
wdLineWidth150pt, wdLineWidth225pt, _
wdLineWidth300pt, wdLineWidth450pt, _
wdLineWidth600pt)
Err_ReEntry:
With Dialogs(wdDialogFormatBordersAndShading)
If .Display <> 0 Then
Shadow = .Shadow
'Shading = .Shading
Shading = ConvertShading(.Shading)
On Error GoTo Error_Handler
If Shading = "No VBA conversion" Then
Err.Raise vbObjectError + 1
End If
ForegroundRGB = .ForegroundRGB
BackgroundRGB = .BackgroundRGB
LeftStyle = .LeftStyle
RightStyle = .RightStyle
TopStyle = .TopStyle
BottomStyle = .BottomStyle
HorizStyle = .HorizStyle
VertStyle = .VertStyle
TL2BRStyle = .TL2BRStyle
TR2BLStyle = .TR2BLStyle
TopColorRGB = .TopColorRGB
LeftColorRGB = .LeftColorRGB
BottomColorRGB = .BottomColorRGB
RightColorRGB = .RightColorRGB
HorizColorRGB = .HorizColorRGB
VertColorRGB = .VertColorRGB
TL2BRColorRGB = .TL2BRColorRGB
TR2BLColorRGB = .TR2BLColorRGB
On Error Resume Next
TopWeight = .TopWeight
' LeftWeight = .LeftWeight
' BottomWeight = .BottomWeight
' Righ
 
 
 

Help with Borderrs and Shading Dialog

Post by Greg Maxe » Tue, 12 Aug 2008 12:54:03

ay,

It looks like the quickest method is to not use arrays at all but stay with
the built in dialog. There is still the issue of several of the texture
selection returning -1 but I think I have a work around figured out. Here
is the code for using an instance of the borderandshading dialog to perform
the formatting. Only when one of those -1 values are selected as the
texture do I need to convert that to a meaninful value and use the table
object itself:

Public Sub ApplyUniformBordersAndShadingToAllTables()
Dim oTables As Tables
Dim oTable As Table
Dim Title As String
Dim n As Long, i As Long
Dim Shading As Long, ShadingModified As Long, Shadow
Dim TopStyle As Long, LeftStyle As Long, BottomStyle As Long
Dim RightStyle As Long, HorizStyle As Long, VertStyle As Long
Dim TL2BRStyle As Long, TR2BLStyle As Long
Dim TopWeight As Long, LeftWeight As Long, BottomWeight As Long
Dim RightWeight As Long, HorizWeight As Long, VertWeight As Long
Dim TL2BRWeight As Long, TR2BLWeight As Long
Dim ForegroundRGB, BackgroundRGB
Dim TopColorRGB, LeftColorRGB, BottomColorRGB
Dim RightColorRGB, HorizColorRGB, VertColorRGB
Dim TL2BRColorRGB, TR2BLColorRGB
On Error Resume Next
Set oTables = ActiveDocument.Tables
On Error GoTo 0
Title = "Apply Uniform Borders to All Tables"
If Not Selection.Information(wdWithInTable) Then oTables(1).Select
If oTables.Count > 0 Then
If MsgBox("This command applies uniform table borders and shading " & _
"to all tables in the active document." & vbCr & vbCr & _
"Do you want to continue?", vbQuestion + vbYesNo, Title) = vbYes
Then
Err_ReEntry:
With Dialogs(wdDialogFormatBordersAndShading)
If .Display <> 0 Then
Shadow = .Shadow
Shading = .Shading
ForegroundRGB = .ForegroundRGB
BackgroundRGB = .BackgroundRGB
LeftStyle = .LeftStyle
RightStyle = .RightStyle
TopStyle = .TopStyle
BottomStyle = .BottomStyle
HorizStyle = .HorizStyle
VertStyle = .VertStyle
TL2BRStyle = .TL2BRStyle
TR2BLStyle = .TR2BLStyle
TopColorRGB = .TopColorRGB
LeftColorRGB = .LeftColorRGB
BottomColorRGB = .BottomColorRGB
RightColorRGB = .RightColorRGB
HorizColorRGB = .HorizColorRGB
VertColorRGB = .VertColorRGB
TL2BRColorRGB = .TL2BRColorRGB
TR2BLColorRGB = .TR2BLColorRGB
On Error Resume Next
TopWeight = .TopWeight
LeftWeight = .LeftWeight
BottomWeight = .BottomWeight
RightWeight = .RightWeight
HorizWeight = .HorizWeight
VertWeight = .VertWeight
TL2BRWeight = .TL2BRWeight
TR2BLWeight = .TR2BLWeight
TR2BLWeight = .TR2BLWeight
On Error GoTo 0
End If
End With
If Shading = -1 Then
ShadingModified = ConvertShading(Shading)
On Error GoTo Error_Handler
If ShadingModified = 0 Then
Err.Raise vbObjectError + 1
End If
End If
For Each oTable In oTables
Application.ScreenRefresh
'Count tables - used in message
n = n + 1
With oTable
.Select
With Application.Dialogs(wdDialogFormatBordersAndShading)
.ApplyTo = 2
.Shadow = Shadow
If Shading <> -1 Then
.Shading = Shading
End If
.ForegroundRGB = ForegroundRGB
.BackgroundRGB = B