Hi there,
I have two macros giving me quick control on the line spacing of text. One is to increase it (Sub SpacingPlus), the other one to set it back to 1.0 (Sub SpacingBackToOnePointZero). Most of the time they both work fine, but there is one exception. Imagine a shape with 4 lines of text. The first 2 lines have 0.8 line spacing, the last 2 lines have 1.2 line spacing. When I want to set all of them back to 1.0 (e. g., by selecting the whole text in the shape) it works. But when I want to keep the difference in the spacing and increase it all 4 lines + 0.1 (e. g., by selecting the whole text in the shape), I get an error. As both macros are composed the same way, I can not really figure out, why one is doing the work and the other one is not. I'd be glad, if someone is able to show me how to repair the first one (Sub SpacingPlus). Thank you!
Sub SpacingPlus()
Dim Shp As Shape
Dim oTbl As Table
Dim x As Long
Dim y As Long
On Error GoTo err
If ActiveWindow.Selection.Type = ppSelectionNone Then 'Nothing!
ElseIf ActiveWindow.Selection.Type = ppSelectionText Then
With ActiveWindow.Selection.TextRange
.ParagraphFormat.SpaceWithin = .ParagraphFormat.SpaceWithin + 0.1
End With
Else
For Each Shp In ActiveWindow.Selection.ShapeRange
If ActiveWindow.Selection.ShapeRange(1).HasTable Then
Set oTbl = ActiveWindow.Selection.ShapeRange.Table
For x = 1 To oTbl.Rows.Count
For y = 1 To oTbl.Columns.Count
If oTbl.Cell(x, y).Selected Then
With oTbl.Cell(x, y).Shape.TextFrame2.TextRange
.ParagraphFormat.SpaceWithin = .ParagraphFormat.SpaceWithin + 0.1
End With
End If
Next
Next
Else
With Shp.TextFrame2.TextRange
.ParagraphFormat.SpaceWithin = .ParagraphFormat.SpaceWithin + 0.1
End With
End If
Next Shp
End If
Exit Sub
err:
MsgBox "Error Message"
End Sub
Sub SpacingBackToOnePointZero()
Dim Shp As Shape
Dim oTbl As Table
Dim x As Long
Dim y As Long
On Error GoTo err
If ActiveWindow.Selection.Type = ppSelectionNone Then 'Nothing!
ElseIf ActiveWindow.Selection.Type = ppSelectionText Then
With ActiveWindow.Selection.TextRange
.ParagraphFormat.SpaceWithin = 1
End With
Else
For Each Shp In ActiveWindow.Selection.ShapeRange
If ActiveWindow.Selection.ShapeRange(1).HasTable Then
Set oTbl = ActiveWindow.Selection.ShapeRange.Table
For x = 1 To oTbl.Rows.Count
For y = 1 To oTbl.Columns.Count
If oTbl.Cell(x, y).Selected Then
With oTbl.Cell(x, y).Shape.TextFrame2.TextRange
.ParagraphFormat.SpaceWithin = 1
End With
End If
Next
Next
Else
With Shp.TextFrame2.TextRange
.ParagraphFormat.SpaceWithin = 1
End With
End If
Next Shp
End If
Exit Sub
err:
MsgBox "Error Message"
End Sub
Unfortunately it is not possible to use these macros (both of them) on two tables or a table and other shapes at the same time, too, but this is not that important.