PDA

View Full Version : [SOLVED] Changing orientation of word doc from excel



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

Paleo
01-27-2005, 06:48 AM
jibbo,

try this:



With AppWord.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape '<- here is what you want. You may delete the rest
.TopMargin = CentimetersToPoints(3)
.BottomMargin = CentimetersToPoints(3)
.LeftMargin = CentimetersToPoints(2.5)
.RightMargin = CentimetersToPoints(2.5)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

gibbo1715
01-27-2005, 07:27 AM
Tried that i get method or data member not found ???

Jacob Hilderbrand
01-27-2005, 07:30 AM
Add this:


Dim Doc As Document

Replace this:


AppWord.Documents.Add

With this:


Set Doc = AppWrd.Documents.Add

Add this:


Doc.PageSetup.Orientation = wdOrientLandscape

gibbo1715
01-27-2005, 07:38 AM
Sorry Jake Get an error object required



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
Dim Doc As Document
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")
Set Doc = AppWrd.Documents.Add '<<<< Error on this line object required
Doc.PageSetup.Orientation = wdOrientLandscape
Set WS = ThisWorkbook.Sheets("Disposal")
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 & "" & 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

Jacob Hilderbrand
01-27-2005, 07:46 AM
Check the variables. One is AppWrd and one is AppWord. Just change them all to match and you should be fine.

gibbo1715
01-27-2005, 08:22 AM
Removes the error jake but then doesnt find the word

Paleo
01-27-2005, 11:42 AM
Why is Cel.Row typed twice here?


WS.Range("A" & Cel.Row & "" & Cel.Row).Copy

Shouldnt it be?


WS.Range("A" & Cel.Row).Copy

Jacob Hilderbrand
01-27-2005, 03:58 PM
I think Paleo has it. The line should either be:

'One Cell

Range("A" & Cel.Row)

Or

'Several Cells

Range("A" & Cel.Row & ":C" & Cel.Row)

gibbo1715
01-28-2005, 06:43 AM
That did it cheers to you both