CODEWITHSUNDEEP
excelvba
0x01_PH
0x01_PH

Reputation: 154

Keep page orientation of a Worksheet

I have a VBA-Macro for Microsoft Excel. The Macro change the Headerimage and the Footercontent for every .xls file in a Folder. The only problem is that the page orientation is automaticly set to landscape. I want to keep the page-orientation from the origin. How to do this?

This is my macro:

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim ImagePath As String
Dim Validation As String

  ImagePath = "\logo.jpg"
  companyname = "companyname"
  contractnumber = "23-23"

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

  myExtension = "*.xls*"

  myFile = Dir(myPath & myExtension)

  Do While myFile <> ""
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
      DoEvents
    
      On Error Resume Next
        Validation = Dir(ImagePath)
      On Error GoTo 0
    
      If Validation = "" Then
        MsgBox "Pfad zu Logo falsch: " & ImagePath
        Exit Sub
      End If

      For Each sheet In ActiveWorkbook.Worksheets
        sheet.activate
          sheet.PageSetup.LeftHeader = "&G"
          sheet.PageSetup.LeftHeaderPicture.Filename = ImagePath
          sheet.PageSetup.LeftFooter = "&[Datei] © " + companyname + ", Vertragsnummer: " + contractnumber
          sheet.DisplayPageBreaks = False
    
      Next sheet
    
      wb.Close SaveChanges:=True
      
      DoEvents

      myFile = Dir
  Loop

'Message Box
  MsgBox "Done"

ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 130

Answers (2)

Dy.Lee
Dy.Lee

Reputation: 7567

It seems that you can get the orientation value of the sheet first and then set it for the orientation again.

Sub test()
    Dim Ws As Worksheet
    Dim i As Integer
    
    Set Ws = ActiveSheet
    
    With Ws.PageSetup
        i = .Orientation
        .Orientation = i
    End With
    MsgBox i
End Sub

Upvotes: 1

J&#246;rgen R
J&#246;rgen R

Reputation: 386

sheet.PageSetup.Orientation = xlPortrait should do the trick.

Upvotes: 0

Related Questions