Druckbereich und Seitenformat für alle Tabellenblätter

[Alphaville]

Hallo zusammen,

ich bin auf der Suche nach einem Makro für mein Problem bisher nicht fündig geworden. Vielleicht kann mir jemand weiterhelfen.

Ich habe einen Ordner in dem mehrere hundert Excel-97-Tabellen (*.xls) liegen. Die einzelnen Dateien haben jeweils unterschiedlich viele Tabellenblätter, mal nur zwei, mal auch fünf oder mehr. Bei jeder dieser Dateien und allen darin enthaltenen Tabellenblättern sollte das Format auf quer gedreht, der Druckbereich auf eine Seite angepasst und anschließend wieder abgespeichert werden.

Ist soetwas mit Open Office machbar? Ich wäre dankbar, falls jemand eine Lösung hätte.

Alphaville

[F3K Total]

Hi,
ja, ist machbar, ich empfehle dann als .ods abzuspeichern.
Makro-Beispiele zum Setzen der Druckbereiche findest du hier im Forum mit dem Suchbegriff

Code: Alles auswählen

setprintareas

.
Über die Google-Suche habe ich eben 41 Treffer gehabt.
Gruß R

[Stephan]

Ist soetwas mit Open Office machbar?

ja, aber doch eher nicht zu empfehlen wegen des xls-Formats. Ich würde die Umwandlung deshalb mit Excel machen.


beispielhaft ginge es mit Calc ungefähr so (nicht getestet!):

Code: Alles auswählen

Sub Dateien_bearbeiten()
    Dim srcs()
    srcs = GetFileNames("D:\Meine_Dateien\","*.xls")
    Dim i As Integer 
    For i = 1 to UBound(srcs) 'srcs(0) enthält Verzeichnis
   	    pfad = ConvertToUrl("D:\Meine_Dateien\" & srcs(i))
   	    tmp = StarDesktop.LoadComponentFromURL(pfad, "_blank", 0, Array())
   	    az = tmp.Sheets().Count
   	    For j = 0 to az-1
   	        akt_style = tmp.getStyleFamilies.getByName("PageStyles").getByName(tmp.Sheets(j).PageStyle)
   	        akt_style.IsLandscape = True
   	        akt_style.ScaleToPages = 1
   	    Next j
   	    tmp.Store()
   	    tmp.Close(True)
    Next i 
    Msgbox "fertig" 
End Sub 
    
Function GetFileNames(dirPath As String, Files As String)
   'https://forum.openoffice.org/en/forum/viewtopic.php?f=20&p=179250
   
   Dim dirValue as String
   Dim a(0) As String
   Dim n As Long
   n = 0
   a(n) = dirPath
   dirValue = Dir(dirPath & Files)
   Do While dirValue <> "" 
      n = n + 1
      Redim Preserve a(n) As String
      a(n) = dirValue
      dirValue = Dir
   Loop 
   GetFileNames = a
End Function

Gruß
Stephan

[Alphaville]

Hallo zusammen,

das hat funktioniert - echt klasse!

Ich musste nur noch das Format auf DIN A4 umstellen:

Code: Alles auswählen

	akt_style.Width = 29700
	akt_style.Height = 21000

Wow, Danke!

Alphaville