Maybe you can use the macro below - at least as a starting point.
I made the macro so that you can add more combinations of styles as desired
just by adding the style names to the variable named "strStyle_NameList" in
the macro (see the comments in the code for syntax information). In the
present code, it will:
- apply Heading 2 to the next cell if the current cell has style Heading 1
- apply Heading 3 if the current cell has style Heading 2
- apply Heading 4 if the current cell has style Heading 3
The macro makes the following:
Finds out which style is used in the _first_ paragraph in the _first_ cell
in the selection.
By checking "strStyle_NameList", the macro finds the style to use in the
next cell.
It then goes to the next cell and applies the relevant style to all text in
the cell (leaves the cell selected - this can be changed if you want). If the
selection is in the last table cell, a new row will be added by the macro.
Some error handling is included in case the selection is not in a table or
the style to be applied does not exist.
The macro could be assigned to a toolbar button and/or a keyboard shortcut
in order to make it easy to execute. You can then skip from cell to cell and
have the style corrected according to your definition in the code.
The idea is that when you have changed the style in the current cell, you
just execute the macro to have the style in the next cell changed. The macro
does _not_ change anything automatically just because you change the style in
a cell - you need to execute it
Sub GoToNextCellAndApplyStyle()
On Error GoTo ErrorHandler
Dim Title As String
Dim n As Long
Dim strStyle_Current As String
Dim strStyle_Next As String
Dim nPos As Long
Title = "Go to Next Table Cell and Apply Style"
'Define a string that holds the styles
'Syntax for each style pair:
'[current style]$[style in next cell]#
'The total list must start and end with #
'Replace # and $ by other character if used
'in the style names
'Add/remove style names as required
Const strStyle_NameList As String = _
"#Heading 1$Heading 2#" & _
"Heading 2$Heading 3#" & _
"Heading 3$Heading 4#"
'Do nothing if selection is not in table
If Selection.Information(wdWithInTable) = False Then
MsgBox "The selection must be in a table."
Exit Sub
End If
'Check style used in first cell in selection
'Go to next cell and apply style to cell
With Selection
'Collapse selection in start of first cell
.Start = .Cells(1).Range.Start
.End = .Start
'Find the style used in the first cell in the selection
strStyle_Current = .Cells(1).Range.Paragraphs(1).Style
'Find out whether style is in defined list
nPos = InStr(1, strStyle_NameList, "#" & strStyle_Current & "$",
vbTextCompare)
If nPos > 0 Then
'Style found, then find out which style to apply
'Done in more steps below
strStyle_Next = Right(strStyle_NameList, _
Len(strStyle_NameList) - 1 - nPos - Len(strStyle_Current))
'Now string starts with the correct name
'Remove from the end until last $ is gone
Do Until InStr(1, strStyle_Next, "#", vbTextCompare) = 0
strStyle_Next = Left(strStyle_Next, _
Len(strStyle_Next) - 1)
Loop
End If
'Go to next cell and apply style
'If in last cell, a new row will be added
.MoveRight Unit:=wdCell
If strStyle_Next <> "" Then
.Range.Style = ActiveDocument.Styles(strStyle_Next)
Else
MsgBox "The style in the previous cell is '" & strStyle_Current
& "'." & vbCr & _
"No 'next cell style' is defined for '" & strStyle_Current &
"'. No style change made."
End If
End With
Exit Sub
ErrorHandler:
If Err.Number = 5941 Then
MsgBox "The style '" & strStyle_Next & "' that was to be " & _
"applied to the selected cell does not exist.", vbCritical,
Title
End If
End Sub
--
Regards
Lene Fredborg
DocTools - Denmark
www.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word
