407 Aufrufe
Gefragt in Tabellenkalkulation von
Habe ein Makro erstellt welches aus einer Tabelle A1-F13 zwei Zeilen ausdruckt.

Sub Makro1()
'
' Makro1 Makro
'

'
ActiveSheet.PageSetup.PrintArea = ""
Rows("2:2").Select
Selection.EntireRow.Hidden = True
Rows("4:2000").Select
Selection.EntireRow.Hidden = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Rows("1:3").Select
Selection.EntireRow.Hidden = False
Rows("3:2000").Select
Selection.EntireRow.Hidden = False
End Sub

Jetzt möchte ich aber das ich A1+eine belibige markierte Zeile ausdrucken kann. Das heißt das in der Spalte G ein x in einer belibiegen Zeile gesetzt wird und ich dann diese Zeile mit Zeile A1 ausdrucken kann. Das x müßte nach dem Drucken wieder verschwinden.
Wäre sehr verbunden Hilfe zu bekommen. Ach so noch was es kommen immer wieder neue Zeilen dazu.

5 Antworten

0 Punkte
Beantwortet von
Hallo,

ich vermute, in A1 steht eine Überschrift?
Dann geht das auch ohne Makro.
Wähle z.B. unter Excel 2010 im Menüband „Seitenlayout“ das Symbol „Drucktitel“ oder gehe direkt über Seite einrichten auf das letzte Register „Blatt“
Dort klickst bei „Wiederholungszeilen oben“ in das Eingabefeld und markierst anschließend im Tabellenblatt die Zeilenköpfe der Überschriftszeilen (im Beispiel Zeile 1), sodass $1:$1 im Eingabefeld erscheint. (kannst du natürlich auch direkt eingeben)
Bestätigen mit OK.

Jetzt kannst du für jede beliebige Zeile einen Druckbereich setzen, die Zeile 1 wird immer zusätzlich mit ausgedruckt. Aber Achtung: Bei einer Mehrfachauswahl wird für jeden gesetzten Druckbereich jeweils eine Seite ausgedruckt.

Gruß Mr. K.
0 Punkte
Beantwortet von
Hallo Mr. K.

habe es soeben ausprobiert. Ist schon mal nen Fortschritt. Werde diese Vorgehensweise erst einmal nutzen. Aber, als Makro wäre es mir lieber, aufgrund der Zeitersparnis bzw. einfacherer dauerhafter Lösung.

Beste Grüße
derdidoro
0 Punkte
Beantwortet von
Hallo nochmal,

also ich finde das jetzt nicht allzu umständlich. Ich habe das Symbol für den Druckbereich immer auf der Schnellstartleiste liegen. Damit ist markieren und drucken im Nu erledigt.

Als Makro für deine Zwecke könnte der Code z.B. wie folgt aussehen. Damit kannst du auch mehrere x setzen.

Sub Drucken()

'Kopfzeile setzen
ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"

'Markierte Zeilen suchen
Set c1 = Columns("G:G").Find("x")
If Not c1 Is Nothing Then
'Ausblenden
first = c1.Address
Do
Set c2 = Columns("G:G").FindNext(c1)
If Not c2 Is Nothing Then
If c2.Row > c1.Row + 1 Then
a = c1.Address: b = c2.Address
Rows(c1.Row + 1 & ":" & c2.Row - 1).Hidden = True
Set c1 = c2
End If
End If
Loop Until c2.Address = first

'Drucken
ActiveSheet.PageSetup.PrintArea = Range(Cells(Range(first).Row, 1), Cells(c1.Row, 6)).Address
ActiveSheet.PrintOut Copies:=1, Collate:=True

'Ausblendung zurücksetzen.
Rows.Hidden = False
Columns("G:G").ClearContents
ActiveSheet.PageSetup.PrintArea = ""
Else
MsgBox "Bitte markieren Sie die zu druckenden Zeilen in Spalte G mit x", vbExclamation
End If

End Sub
Gruß Mr. K.
0 Punkte
Beantwortet von
Uups, war noch ein kleiner Bug drin. So ist der code richtig.

Sub Drucken()

'Kopfzeile setzen
ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"

'Markierte Zeilen suchen
Set c1 = Columns("G:G").Find("x")
If Not c1 Is Nothing Then
'Ausblenden
first = c1.Address
Do
Set c2 = Columns("G:G").FindNext(c1)
If Not c2 Is Nothing Then
If c2.Row > c1.Row + 1 Then
Rows(c1.Row + 1 & ":" & c2.Row - 1).Hidden = True
Set c1 = c2
ElseIf c2.Row = c1.Row + 1 Then
Set c1 = c2
End If
End If
Loop Until c2.Address = first

'Drucken
ActiveSheet.PageSetup.PrintArea = Range(Cells(Range(first).Row, 1), Cells(c1.Row, 6)).Address
ActiveSheet.PrintOut Copies:=1, Collate:=True

'Ausblendung zurücksetzen.
Rows.Hidden = False
Columns("G:G").ClearContents
ActiveSheet.PageSetup.PrintArea = ""
Else
MsgBox "Bitte markieren Sie die zu druckenden Zeilen in Spalte G mit x", vbExclamation
End If

End Sub
Mr. K.
0 Punkte
Beantwortet von
Hi Mr. K.,

werde dein Code ausprobieren und dich informieren.

Vorab schon einmal Thx für Deine Unterstützung.

Gruß
derdidoro
...