lady_miss22
10-28-2008, 10:32 PM
How can I manipulate this code so that it also reads through text boxes? It's currently an on/off macro written to find bolded text and turn it white essentially to make it "disappear" and vice versa. There is also word art that appears and disappears (this is a teachers quiz) However it skips through the text boxes.
Sub ShowAnswers()
Dim Flag As Boolean
Dim aShape As Shape
Dim sLine As String
Dim sTrans As String
Dim sSource As Document
Set sSource = ActiveDocument
Flag = False
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorWhite
With Selection.Find
If .Execute = True Then
Flag = True
End If
Do While .Execute(FindText:="", MatchWildcards:=False, MatchCase:=True, Wrap:=wdFindContinue, Forward:=True) = True
With Selection.Font
.Color = wdColorAutomatic
.Bold = True
End With
Loop
End With
If Flag = True Then
sTrans = 1#
sLine = msoFalse
With sSource
For Each aShape In .Shapes
If aShape.Type = msoTextEffect Then
aShape.Select
With Selection
.ShapeRange.Fill.Transparency = sTrans
.ShapeRange.Line.Visible = sLine
End With
End If
Next aShape
End With
Exit Sub
Else
sTrans = 0#
sLine = msoTrue
End If
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorAutomatic
Selection.Find.Font.Bold = True
With Selection.Find
Do While .Execute(FindText:="", MatchWildcards:=False, MatchCase:=True, Wrap:=wdFindContinue, Forward:=True) = True
With Selection.Font
.Color = wdColorWhite
End With
Loop
End With
With sSource
For Each aShape In .Shapes
If aShape.Type = msoTextEffect Then
aShape.Select
With Selection
.ShapeRange.Fill.Transparency = sTrans
.ShapeRange.Line.Visible = sLine
End With
End If
Next aShape
End With
End Sub
Also, I found the following code on how to do it and would much rather use this one instead of the selection.find but I have no idea how to make it work like an on/off macro and do what my first code does.
Public Sub FindReplaceAlmostAnywhere()
Dim rngStory As Word.Range
Dim lngJunk As Long
'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
With rngStory.Find
.Text = "find text"
.Replacement.Text = "I'm found"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
PLEASE HELP!
Edit by lucas: VBA tags added to code. lady_miss22, if you select your code when posting and hit the vba button your code will be formatted as above.
Sub ShowAnswers()
Dim Flag As Boolean
Dim aShape As Shape
Dim sLine As String
Dim sTrans As String
Dim sSource As Document
Set sSource = ActiveDocument
Flag = False
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorWhite
With Selection.Find
If .Execute = True Then
Flag = True
End If
Do While .Execute(FindText:="", MatchWildcards:=False, MatchCase:=True, Wrap:=wdFindContinue, Forward:=True) = True
With Selection.Font
.Color = wdColorAutomatic
.Bold = True
End With
Loop
End With
If Flag = True Then
sTrans = 1#
sLine = msoFalse
With sSource
For Each aShape In .Shapes
If aShape.Type = msoTextEffect Then
aShape.Select
With Selection
.ShapeRange.Fill.Transparency = sTrans
.ShapeRange.Line.Visible = sLine
End With
End If
Next aShape
End With
Exit Sub
Else
sTrans = 0#
sLine = msoTrue
End If
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorAutomatic
Selection.Find.Font.Bold = True
With Selection.Find
Do While .Execute(FindText:="", MatchWildcards:=False, MatchCase:=True, Wrap:=wdFindContinue, Forward:=True) = True
With Selection.Font
.Color = wdColorWhite
End With
Loop
End With
With sSource
For Each aShape In .Shapes
If aShape.Type = msoTextEffect Then
aShape.Select
With Selection
.ShapeRange.Fill.Transparency = sTrans
.ShapeRange.Line.Visible = sLine
End With
End If
Next aShape
End With
End Sub
Also, I found the following code on how to do it and would much rather use this one instead of the selection.find but I have no idea how to make it work like an on/off macro and do what my first code does.
Public Sub FindReplaceAlmostAnywhere()
Dim rngStory As Word.Range
Dim lngJunk As Long
'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
With rngStory.Find
.Text = "find text"
.Replacement.Text = "I'm found"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
PLEASE HELP!
Edit by lucas: VBA tags added to code. lady_miss22, if you select your code when posting and hit the vba button your code will be formatted as above.