Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
536to540
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Druckbereich festlegen und anpassen

Druckbereich festlegen und anpassen
27.12.2004 00:18:16
liane
Guten abend liebe Excelgemeinde
Ich hätte eine Frage
Wie lege ich in Tabelle 1 einen Druckbereich von C15 bis P48 fest, passe das Druckformat auf Querformat an und das das ganze auf ein Blatt gedruckt wird.
Ich frage deshalb, da ich 20 solche bereiche in einem Blatt habe und diese nicht immer einzeln einrichten will.
Für hilfe wäre ich sehr dankbar
Liane

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckbereich festlegen und anpassen
27.12.2004 00:23:10
Josef
Hallo Liane!
das geht zB. so:

Sub Liane()
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintArea = "$C$15:$P$48"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub

Gruß Sepp
AW: Druckbereich festlegen und anpassen
liane
hallo sepp
der ansatz ist schon ganz gut nur druckt er nicht und wenn ich anschliesen auf drucken gehe passt es nicht auf ein blatt.
kannst du nochmal nachschauen
danke
AW: Druckbereich festlegen und anpassen
27.12.2004 00:47:41
Josef
Hallo Liane!
Bei mir funktioniert es wie gewünscht!

Sub Liane()
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintArea = "$C$15:$P$48"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveSheet.PrintOut
End Sub

Gruß Sepp
Anzeige
AW: Druckbereich festlegen und anpassen
liane
hallo
drucken geht jetzt aber er druckt 4 seiten
Gruß liane
AW: Druckbereich festlegen und anpassen
27.12.2004 00:57:25
Josef
Hallo Liane!
Dann probieren wir noch das:

Sub Liane()
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintArea = "$C$15:$P$48"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveSheet.PrintOut from:=1, to:=1
End Sub

Gruß Sepp
AW: Druckbereich festlegen und anpassen
liane
Super das funktioniert 1a
vielen Dank, Liane
könnte ich noch eine andere frage stellen?
Probier's einfach ;-) o.T.
27.12.2004 01:05:53
Josef
Gruß Sepp
AW: Probier's einfach ;-) o.T.
liane
Ist aber was ganz anderes
Mit diesem Makro überprüfe ich, ob in de Spalten (B6 bis B36, F6 bis F36 jnrvz) Kommentare sind, diese werden dann gelöscht. Ich möchte aber prüfen ob in folgenden Spalten Kommentare sind die dann gelöscht werden sollen.
D17 bis 47, D69 bis 99 d120 bis 150

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "P2" Then Exit Sub
Application.ScreenUpdating = False
EnableEvents = False
For n = 1 To 12
sp = (n - 1) * 4
Range(Cells(6, sp + 1), Cells(36, sp + 2)).ClearContents
Range(Cells(6, sp + 1), Cells(6, sp + 2)) = DateSerial([P2], n, 1)
letzte = 30
While Month(Cells(6, sp + 1) + letzte) <> Month(Cells(6, sp + 1))
letzte = letzte - 1
Wend
'Range(Cells(6, sp + 1), Cells(6, sp + 2)).AutoFill Destination:=Range(Cells(6, sp + 1), Cells(6 + letzte, sp + 2)), Type:=xlFillDefault
Range(Cells(6, sp + 1), Cells(6 + letzte, sp + 2)).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
xlDay, Step:=1, Trend:=False
Next n
Call Kommentar
EnableEvents = True
Application.ScreenUpdating = True
End Sub

Mit diesem makro sollen die koomentare dann reingeschrieben werden. Mir geht es nur um die Zellen bzw Spalten zuweisung.
Sub Kommentar()
On Error Resume Next 'gibt Fehler wenn kein Kommentar vorhanden
With Worksheets("FS-Planer")
Set Bereich = Application.Union(.Range("b6:b36"), .Range("f6:f36"), .Range("j6:j36"), _
.Range("n6:n36"), .Range("r6:r36"), .Range("v6:v36"), .Range("z6:z36"), .Range("Ad6:Ad36"), .Range("Ah6:Ah36"), _
.Range("Al6:Al36"), .Range("Ap6:Ap36"), .Range("At6:At36"))
Bereich.SpecialCells(xlCellTypeComments).ClearComments
For n = 100 To 134
z = 5 + Day(Worksheets("Fs-Planer").Cells(n, 1))
s = (Month(Worksheets("Fs-Planer").Cells(n, 1)) - 1) * 4 + 2
.Cells(z, s).AddComment
.Cells(z, s).Comment.Visible = False
.Cells(z, s).Comment.Text Text:=Worksheets("Fs-Planer").Cells(n, 2).Value
Next n
End With
End Sub
etwas verwirrend, aber vieleicht kannst du was mit anfangen
gruss liane
Anzeige
AW: Probier's einfach ;-) o.T.
27.12.2004 01:27:26
Josef
Hallo Liane!
In den Code will ich icht gar nicht vertiefen.
Wenn es dir nur um den Bereich "D17:47, D69:D99, D120:D150" geht, dann so:

Sub Kommentar2()
Dim n As Integer
With Worksheets("FS-Planer")
n = 17
Do
On Error Resume Next
.Cells(n, 4).Comment.Delete
.Cells(n, 4).AddComment
.Cells(n, 4).Comment.Visible = False
.Cells(n, 4).Comment.Text Text:=.Cells(n, 2).Value
On Error GoTo 0
n = n + 1
If n = 48 Then n = 69
If n = 100 Then n = 120
Loop While n < 151
End With
End Sub

Gruß Sepp
AW: Probier's einfach ;-) o.T.
liane
Nein, es geht bis in Zelle 610
würde das so stimmen ?

Sub Kommentar2()
Dim n As Integer
With Worksheets("FS-Planer")
n = 17
Do
On Error Resume Next
.Cells(n, 4).Comment.Delete
.Cells(n, 4).AddComment
.Cells(n, 4).Comment.Visible = False
.Cells(n, 4).Comment.Text Text:=.Cells(n, 2).Value
On Error GoTo 0
n = n + 1
If n = 48 Then n = 69
If n = 100 Then n = 120
Loop While n < 611
End With
End Sub

und zweitens, das makro zum kommentar eintragen, kann man das so lassen ?
Ich weiß ich bin schlimm aber ....
liane
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige