gibbo1715
01-27-2005, 06:18 AM
The awsome DrJ ( Jake) gave me with the code below, what i need to do is open the word doc in landscape instead of portraite
Any ideas?
Dim Cel As Range
Dim WS As Worksheet
Dim FirstAddress As String
Dim AppWord As Word.Application
Dim Word As String
Dim Prompt As String
Dim Search As String
Prompt = "What do you want to search for?"
Title = "Search Criteria"
Search = InputBox(Prompt, Title)
If Search = "" Then
MsgBox "Nothing Selected"
End If
Set AppWord = CreateObject("Word.Application")
AppWord.Documents.Add
Set WS = ThisWorkbook.Sheets("Exhibits")
With WS.Cells
Set Cel = .Find(What:=Search, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do
WS.Range("A" & Cel.Row & ":D" & Cel.Row).Copy
AppWord.Selection.Paste
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
End If
End With
AppWord.Selection.Find.ClearFormatting
AppWord.Selection.Find.Replacement.ClearFormatting
With AppWord.Selection.Find
.Text = Search
.Replacement.Font.name = "Arial Black"
.Replacement.Font.Color = wdColorRed
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
AppWord.Selection.Find.Execute Replace:=wdReplaceAll
AppWord.Visible = True
Any ideas?
Dim Cel As Range
Dim WS As Worksheet
Dim FirstAddress As String
Dim AppWord As Word.Application
Dim Word As String
Dim Prompt As String
Dim Search As String
Prompt = "What do you want to search for?"
Title = "Search Criteria"
Search = InputBox(Prompt, Title)
If Search = "" Then
MsgBox "Nothing Selected"
End If
Set AppWord = CreateObject("Word.Application")
AppWord.Documents.Add
Set WS = ThisWorkbook.Sheets("Exhibits")
With WS.Cells
Set Cel = .Find(What:=Search, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do
WS.Range("A" & Cel.Row & ":D" & Cel.Row).Copy
AppWord.Selection.Paste
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
End If
End With
AppWord.Selection.Find.ClearFormatting
AppWord.Selection.Find.Replacement.ClearFormatting
With AppWord.Selection.Find
.Text = Search
.Replacement.Font.name = "Arial Black"
.Replacement.Font.Color = wdColorRed
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
AppWord.Selection.Find.Execute Replace:=wdReplaceAll
AppWord.Visible = True