Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1480to1484
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
Inhaltsverzeichnis

Gruppieren von Blättern bei identischem Zellinhalt

Gruppieren von Blättern bei identischem Zellinhalt
20.03.2016 15:23:39
Blättern
Hallo zusammen,
bastle mir gerade einen Code zusammen; ein kleiner, aber wichtiger Teil fehlt mir noch:
In meiner Datei gibt es immer genau zwei Blätter mit identischem Zellinhalt in A1 (jeweils Haupt- und Zusatzblatt).
Wenn ich im Hauptblatt bin, möchte ich dieses mit dem Zusatzblatt über VBA gruppieren, um danach beide Blätter miteinander zu drucken.
Für Profis sicher eine einfache Übung !?
Danke schön schon jetzt
Margarete

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gruppieren von Blättern ...
20.03.2016 17:46:00
Blättern
Hallo Margarete,
probiers mal damit:
Sub Makro1()
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
sPrüfText = [A1].Value
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).[A1].Value = sPrüfText Then
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Exit Sub
End If
Next a
End Sub
Servus

AW: Rückfrage Gruppieren von Blättern
20.03.2016 18:31:53
Blättern
Hallo Herbert,
hab herzlichen Dank für den Code. Jetzt muss ich ihn erst mal verstehen, und das kann dauern....
Als VBA-Anfänger stellt sich mir jetzt das Problem, wie ich diese beiden Blätter (unterschiedlich) formatiere. Hier habe ich mich wohl überschätzt.
Hauptblatt müsste so funktionieren:
ActiveSheet.PageSetup
.PrintArea = "$A$6:$L$25"
.Orientation = xlPortrait
.PaperSize = xlPaperA3
End With
'Aber wo bzw wie füge ich die Formatierung für das zweite Blatt ein, z.B.
.Orientation = xlLandscape
.PaperSize = xlPaperA4
End With
'Dann der Druckbefehl:
Application.Dialogs(xlDialogPrint).Show
'Gruppierung wieder aufheben könnte so gehen:
ThisWorkbook.Sheets("Start").Select
End Sub
Könntest du mir hier auch noch weiterhelfen? Wäre toll
Nochmal vielen Dank
Margarete

Anzeige
AW: Rückfrage Gruppieren von Blättern
20.03.2016 18:40:02
Blättern
Hallo Margarete,
gerne helfe ich dir weiter, doch nur, wenn du mir eine Beispiel-Datei hochlädst, damit ich mir die viele Tipparbeit erspare.
Servus

AW: Rückfrage Gruppieren von Blättern
20.03.2016 18:56:19
Blättern
Hi zusammen,
hier mal in Herberts Code eingefügt (aber ungetestet):
Sub Makro1()
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
sPrüfText = [A1].Value
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).[A1].Value = sPrüfText Then
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$6:$L$25"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA3
'           .PrintOut
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$6:$L$25" ' ?
.PageSetup.Orientation = xlLandscape
.PageSetup.PaperSize = xlPaperA4
'           .PrintOut
End With
'        oder wenn ohne PrintOut wie gehabt
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub
Schöne Grüße,
Michael

Anzeige
AW: Rückfrage Gruppieren von Blättern
20.03.2016 19:40:47
Blättern
Hallo Herbert und Michael,
wow, ein zweiter Helfer - ganz lieben Dank.
Trotzdem lade ich jetzt mal die Beispieldatei hoch. Falls du /ihr Zeit habt, schau(t) doch mal rein.
DANKE SCHÖÖN
Margarete
https://www.herber.de/bbs/user/104482.xlsm

AW: Rückfrage Gruppieren von Blättern
21.03.2016 09:55:38
Blättern
Hallo Margarete,
schau mal, was ich gerade in einem anderen Forum einem Fragenden nach einem ellenlangen Frage- + Antwort-Spiel geschrieben habe:
Es ist echt ein Drama mit euch Fragenden! Warum könnt ihr euch nicht etwas mehr bemühen und versuchen, euch besser in uns Helfende hinein zu versetzen! Ständig muss man wieder rückfragen, da euere Angaben immer so unvollkommen sind. Warum könnt ihr uns denn nicht die ganze "Story" gleich am Anfang erzählen? Wir müssen uns mühsam Stück für Stück an die vollständige Aufgabe heran fragen! Es ist wirklich zum Haare raufen. Wir helfen ja gerne, aber warum macht ihr es uns denn sooo schwer?
Und das gilt mittlerweile sinngemäß auch für dich! Deine erste Anfrage, mit dem Selektieren von 2 Blättern war völlig unnötig, da du nicht 2 Blätter selektieren, sondern 2 Blätter drucken willst.
Die Auswahl der 2 zu druckenden Blätter könntest du dir und uns erheblich vereinfachen, wenn du das zweite Blatt, welches ja namentlich immer zu dem Ersten gehört, einfach mit dem selben Namen versehen und dann eine "2" anhängen würdest. Möglichst ohne Blank. Dann könnte man per VBA die beiden zu druckenden AB sehr einfach ansprechen und drucken.
Dann die Sache mit dem Druckbereich! Den kannst du doch bereits beim erstellen der AB einrichten, da der Datenbereich ja bereits vorgegeben ist und dann brauchst du dich beim drucken nicht mehr darum zu kümmern, resp. muss er beim Programmieren nicht mehr berücksichtigt werden!
Was meinst du eigentlich mit diesem Satz: so könnte man auch die Tabellenblattnamen mit "enthält" ansprechen, falls das einfacher wäre
So, "nu sach ma wat Sache iss"!
Servus

Anzeige
AW: Rückfrage Gruppieren von Blättern
21.03.2016 13:03:07
Blättern
Hallo Herbert,
habe volles Verständnis für deine Reaktion. Trotzdem meine Rückmeldung:
Es ist echt ein Drama mit euch Fragenden! Warum könnt ihr euch nicht etwas mehr bemühen und versuchen, euch besser in uns Helfende hinein zu versetzen! Ständig muss man wieder rückfragen, da euere Angaben immer so unvollkommen sind. Warum könnt ihr uns denn nicht die ganze "Story" gleich am Anfang erzählen? Wir müssen uns mühsam Stück für Stück an die vollständige Aufgabe heran fragen! Es ist wirklich zum Haare raufen. Wir helfen ja gerne, aber warum macht ihr es uns denn sooo schwer?
Ich hatte schon früher eine ausführliche Anfrage gestartet, auf die ich aber keine für mich sinnvolle Antwort erhalten hatte. Deshalb habe ich selbst über mehrere Recherchen versucht, mich in das Problem einzuarbeiten und war der Meinung, dass der Rest schon passen würde. War wie gesagt eine Fehleinschätzung.
Und das gilt mittlerweile sinngemäß auch für dich! Deine erste Anfrage, mit dem Selektieren von 2 Blättern war völlig unnötig, da du nicht 2 Blätter selektieren, sondern 2 Blätter drucken willst.
Ich hatte im Archiv einen Code gefunden, mit dem die beiden Blätter gruppiert und dann gedruckt werden, aber eben nicht mit Zellbezug, sondern mit Namen. Dann hätte ich für ca 30-40 "Pärchen" den Code anpassen müssen. Außerdem kommen immer weitere Blätter hinzu. Meine Idee war, dass ich am Schluss einfach im ersten Hauptblatt eine Form "Druck" einfüge, das Makro zuweise und in die anderen Hauptblätter kopiere. Das könnte ich auch Kollegen leicht erklären, wenn ich z.B. krank bin, was häufiger passiert.
Leider war mir nicht klar, dass ich die Blätter nicht "selektieren" muss; mangelndes VBA-Wissen, was in diesem Zusammenhang der Ausdruck "selektieren" bedeutet; ich nahm an, das bedeute wie in "Normalsprach" einfach "auswählen".
Die Auswahl der 2 zu druckenden Blätter könntest du dir und uns erheblich vereinfachen, wenn du das zweite Blatt, welches ja namentlich immer zu dem Ersten gehört, einfach mit dem selben Namen versehen und dann eine "2" anhängen würdest. Möglichst ohne Blank. Dann könnte man per VBA die beiden zu druckenden AB sehr einfach ansprechen und drucken.

So eine ähnliche Idee hatte ich beim Erstellen der Beispieldatei (siehe deine Rückfrage am Ende). Vermutlich habe ich mich da wieder mal falsch ausgedrückt. Auf die Idee mit dem "enthält" kam ich, da die zweiten Blätter von Excel automatisch mit dem Zusatz (blank)(2) versehen werden. Ob das geht, weiß ich nicht. Ich kenne eben von der bedingten Formatierung diese Möglichkeit (beginnt mit, enthält usw)
Dann die Sache mit dem Druckbereich! Den kannst du doch bereits beim erstellen der AB einrichten, da der Datenbereich ja bereits vorgegeben ist und dann brauchst du dich beim drucken nicht mehr darum zu kümmern, resp. muss er beim Programmieren nicht mehr berücksichtigt werden!
Grund siehe oben. Aber du hast natürlich völlig recht.
Was meinst du eigentlich mit diesem Satz: so könnte man auch die Tabellenblattnamen mit "enthält" ansprechen, falls das einfacher wäre
Also entschuldige bitte den Zusatzaufwand – ich wusste es nicht besser.
Deinen von Michael ergänzten Code werde ich so verwenden und deine Hinweise dabei beachten.
Vielen lieben Dank und beste Grüße
Margarete

Anzeige
allg. Informationen zu Blättern
21.03.2016 17:18:50
Michael
Hi zusammen,
Eure "Argumente" habe ich zur Kenntnis genommen, ich möchte aber nicht weiter darauf eingehen.
Inhaltlich war ja auch was geboten: das mit den Druckbereichen kann hakelig sein, insbesondere, wenn eine "Kamera" verwendet wird: ohne es vertieft bzw. ausprobiert zu haben, sage ich mal einfach, die wird wie ein "Grafikobjekt" behandelt, so daß ein "automatisches" Ermitteln des Druckbereichs via VBA etwas aufwendiger werden dürfte - hier finde ich Herberts Vorschlag, die DBe grundsätzlich bereits im Vorfeld händisch festzulegen, am sinnvollsten.
Eine andere Frage zum wie und warum hat sich mir aber noch gestellt: hast Du einen Drucker bzw. Kopierer mit mehreren Einzugsschächten für verschiedene Papiergrößen? Macht der das auch brav?
Ich habe das von Herbert & mir entwickelte Makro mal in Deine Datei gepackt (Modul: Forum), zusammen mit zwei weiteren Makros, die Dir hoffentlich verdeutlichen, wie sich das mit den Blättern verhält:
Option Explicit
Sub M_BlattKopieren()
' Aufrufen mit Strg+Umschalt+K
Dim actSh As Worksheet, neuesSh As Worksheet
Set actSh = ActiveSheet
MsgBox "Aktives Blatt Name: " & actSh.Name & " Nr.: " & actSh.Index _
& vbLf & "Anzahl Blätter gesamt: " & Sheets.Count
Sheets("Lieferanten").Copy after:=Sheets(Sheets.Count) ' z.B. ganz rechts
Set neuesSh = ActiveSheet
MsgBox "Neues Blatt Name: " & neuesSh.Name & " Nr.: " & neuesSh.Index _
& vbLf & "Anzahl Blätter gesamt: " & Sheets.Count
neuesSh.Name = "mein_neuer_Name"
MsgBox "Neues Blatt Name: " & neuesSh.Name & " Nr.: " & neuesSh.Index
actSh.Activate ' zurück zum Blatt, von dem aus der Aufruf erfolgt ist
' neuesSh.Delete ' ggf. neues Blatt löschen
End Sub
Sub M_Blatt_Schleifen()
' Aufrufen mit Strg+Umschalt+S
Dim actSh As Worksheet, laufSh As Worksheet
Dim actShNr&, neuesShNr&, maxShNr&, i&
Dim message$
' & = "As Long", % = "as Integer", $ = "as String"
' Schleife numerisch via Index:
actShNr = ActiveSheet.Index
maxShNr = Sheets.Count
For i = 1 To maxShNr
If i  actShNr Then
MsgBox "Blatt Nr.: " & i & " Name: " & Sheets(i).Name
Else
MsgBox "Blatt Nr.: " & i & " Name: " & Sheets(i).Name & vbLf & _
"Hey, von diesem Blatt aus wurde das Makro aufgerufen"
End If
Next
' Schleife mit Blättern als Worksheet-Objekt
Set actSh = ActiveSheet
For Each laufSh In Worksheets
If actSh.Name  laufSh.Name Then
message = "Blatt Nr.: " & laufSh.Index & " Name: " & laufSh.Name
Else
message = "Blatt Nr.: " & laufSh.Index & " Name: " & laufSh.Name _
& vbLf & "Hey, von diesem Blatt aus wurde das Makro aufgerufen"
End If
If InStr(laufSh.Name, "(2)") = 0 Then
message = message & vbLf & "Von diesem Blatt aus könnte man auch" _
& vbLf & "das Blatt -" & laufSh.Name & " (2)" & "- aufrufen."
End If
MsgBox message
Next
MsgBox "Das 'Aktive Blatt' ist immer noch " & actSh.Name & " = " & _
ActiveSheet.Name
End Sub

Beide Makros kannst Du von jedem beliebigen Blatt aufrufen, die Tastenkombi steht unter dem jeweiligen Namen.
Zusätzlich kannst Du mal beide Makros mit der F8-Taste zeilenweise durchlaufen lassen und beobachten, was passiert.
Ich denke, das wird Dir den nötigen "Kick" für das Kopieren von Blättern und das Ändern der von Excel automatisch vergebenen Namen (xxx (2)) geben...
Schöne Grüße,
Michael

Anzeige
AW: und hier die Datei
22.03.2016 14:38:08
MB12
Hallo Michael (+ Herbert)
da hast du mir ja Hausaufgaben gegeben, wow! Da ich den Code (noch nicht) fließend lesen kann, muss ich mich erst mal einwühlen. Ich erkenne aber zumindest, dass du mir hier ein Tool geliefert hast, wie ich die neuen Blätter mit dem gewünschten Namen anlegen kann - das ist äußerst nützlich und werde es auch für andere Dateien einsetzen können. Heute Nachmittag werde ich mal ausführlich damit spielen - der "Kick" ist da.
Nochmal zu den Druckbereichen: Ich wusste schon, dass ich durch die Kamera eine Grafik erzeuge und habe anaysiert, wieviele Zeilen ich min/max haben werde. Entsprechend ist auch meine Seite "Lieferanten" aufgebaut, und ich will 2 Versionen des Makros anlegen (Druckbereich kurz/lang + 3 Zeilen). Ich denke, dass ich so auf der sicheren Seite sein werde.
Die Drucker in der Firma haben jeweils mehrere Schächte A4 und A3. Hier zu Hause natürlich nicht - aber da sehe ich ja die Vorschau.
Also nochmal meinen herzlichen Dank!
Margarete

Anzeige
das freut mich,
22.03.2016 17:15:24
Michael
Margarete,
wenn meine Ausführungen auf fruchtbaren Boden bzw. Geist treffen...
Man kann auch die Position bzw. "Ecken" von Grafiken auslesen; ich hatte seinerzeit ein bißchen was dazu geschrieben bzw. eine Datei hochgeladen
https://www.herber.de/forum/archiv/1440to1444/t1443097.htm
FALLS Du so weit einsteigen möchtest - die Zeit ist kostbar.
Also, vielen Dank für die freundliche Rückmeldung &
happy exceling,
Michael

AW: das freut mich,
22.03.2016 17:44:41
MB12
Hallo Michael,
na und ob. Ohne Dazulernen würde ich alt werden (was ich mit 59 eh bald sein werde...). Aber ich lebe nach dem Motto: Wenn ich keine Aufgabe habe, hole ich mir eine und versuche dann, sie zu lösen.
Und da ich im Moment krank zu Hause sitze, kommt das genau richtig.
Liebe Grüße
Margarete

Anzeige
dann umso mehr,
23.03.2016 13:50:54
Michael
Margarete,
irgendwer hat mir erzählt, unser Herr Adorno (der Theodor W.) habe mit 90 noch angefangen, englisch zu lernen ...
Ich selbst lerne aber auch laufend dazu: jede Antwort kann nur eine Momentaufnahme meiner jeweiligen Kenntnisse zu dem Zeitpunkt sein, bestenfalls, abzüglich Tagesform, hehe.
Na gut: ich muß Kaffee machen, abspülen, auf - und deshalb das Forum räumen,
Dir gute Besserung und schöne Grüße,
Michael
P.S.: Habe das erst grad noch gesehen:
Versuch mal:
Sub MakroDruck2()
Dim iActiveSheetNr&, iCount&, a&, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
sTab1 = Sheets(iActiveSheetNr).Name
iCount = Sheets.Count
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).Name = sTab1 & " (2)" Then     'funktioniert nicht
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$1:$K$70"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA3
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$1:$D$55"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'           .PrintOut
End With
'        oder wenn ohne PrintOut wie gehabt
'         sTab1 = Sheets(iActiveSheetNr).Name ' Zuweisung VOR Schleife...
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub

Anzeige
AW: dann umso mehr,
23.03.2016 15:03:35
MB12
Hallo Michael,
den Theodor W. kannte ich nur aus seiner Auseinandersetzung mit der APO; für weiteres war ich zu jung.
Schade, mit dem Makro hat sich auch jetzt nichts getan, auch nicht mit Tab1 und Tab2
Vielleicht wird es für dich übersichtlicher, wenn ich das funktionierende Makro und das nicht funktionierende aufführe (die Details lasse ich weg):
Gut:
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
sPrüfText = [A1].Value
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).[A1].Value = sPrüfText Then
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$1:$K$70"
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$1:$D$55"
End With
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub
Nicht gut:
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
For a = iActiveSheetNr + 1 To iCount
If sTab2 = sTab1 & "2" Then 'funktioniert auch so leider nicht
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$1:$K$70"
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$1:$D$55"
End With
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub
Sehe gerade in der Vorschau, dass die Einzüge plötzlich weg sind - geht es auch so?
Beste Grüße
Margarete

Anzeige
AW: dann umso mehr,
23.03.2016 16:23:36
Michael
Hi Margarete,
dann kopiere das doch bitte mal so, wie ich es geschrieben habe - was Du mir als nicht funktionsfähig zeigst, ist was völlig anderes...
Schöne Grüße,
Michael

AW: ursprünglicher Code
23.03.2016 16:31:10
MB12
Hi Michael,
na klar, gerne (ich hoffe, du hast dies gemeint):
Quote:
hier mal in Herberts Code eingefügt (aber ungetestet):
Sub Makro1()
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
sPrüfText = [A1].Value
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).[A1].Value = sPrüfText Then
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$6:$L$25"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA3
'           .PrintOut
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$6:$L$25" ' ?
.PageSetup.Orientation = xlLandscape
.PageSetup.PaperSize = xlPaperA4
'           .PrintOut
End With
'        oder wenn ohne PrintOut wie gehabt
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub
Beste Grüße, Margarete

Nein!
23.03.2016 16:40:25
Michael
Hi Margarete,
das, was ich am/um 23.03.2016 13:50:54 gepostet habe, das war der letzte Stand nach Deiner Frage von 23.03.2016 13:07:44
Ois klar?
Happy exceling,
Michael

AW: Nein!
23.03.2016 17:00:58
MB12
Ois klar:
Sub MakroDruck2()
Dim iActiveSheetNr&, iCount&, a&, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
sTab1 = Sheets(iActiveSheetNr).Name
iCount = Sheets.Count
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).Name = sTab1 & " (2)" Then     'funktioniert nicht
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$1:$K$70"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA3
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$1:$D$55"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'           .PrintOut
End With
'        oder wenn ohne PrintOut wie gehabt
'         sTab1 = Sheets(iActiveSheetNr).Name ' Zuweisung VOR Schleife...
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub

genau,
24.03.2016 10:50:05
Michael
Margarete,
und, haut's jetzt hin?
Noch ein weiterer Kommentar zur Erhellung: Excel kennt leider keinen "direkten" Befehl, um zu überprüfen, ob ein Blatt existiert.
Naheliegend wäre ja eine Zuweisung á la
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = sTab1 & " (2)"
Nur, was ist, wenn sTab2 nicht existiert? Genau: das Makro bleibt mit einer Fehlermeldung stehen.
[um das zu umgehen, baut man um die kritische Anweisung herum ein Fehlermanagement:
on error goto xxx
Sheets(Array(sTab1, sTab2)).Select
xxx: blabla

Näheres dazu siehe: http://www.online-excel.de/excel/singsel_vba.php?f=145]
Die vorhandene Schleife läuft zwar auf keine Fehler, aber man weiß hinterher auch nicht, ob sie "erfolgreich" gelaufen ist.
Quatsch, man weiß es natürlich, weil dann einfach kein Druckdialog kommt, aber es ließe sich auch eine Meldung dazu einbauen, und zwar nach der Schleife und vor dem End Sub:
MsgBox "Blatt " & sTab1 & " (2) nicht gefunden."
Schöne Feiertage,
Michael

AW: genau,
24.03.2016 11:48:22
MB12
Guten Morgen, Michael,
völlig logisch! Wenn man die Lösung sieht, weiss man genau, woran man nicht gedacht hat. Das hätte auch ein Anfänger wie ich sehen müssen...
Werde ich heute noch ausprobieren. Und der Vorschlag mit der MsBox ist natürlich klasse! Das mit dem Fehlermanagement hatte ich gestern auch in einem Tutorial gelesen und mir gedacht, dass ich das einbauen sollte - passt ja wie Faust aufs Auge.
Im Moment bin ich noch an einigen anderen Baustellen in meinem "Monster". Jede Zelle hat theoretisch Auswirkungen auf mindestens 7 weitere Blätter, deshalb muss ich alles mit Funktionen aufbauen. 598 Abfragekriterien, knapp 100 Tabellenblätter. Ist eigentlich ein typischer Fall für eine Datenbank, das ist aber nicht gewünscht. Und dann die ganzen Sonderwünsche. Aber wem sag ich das - das erlebst du ja laufend.
Also weiter im Text mit dem guten alten Excel. Irgendwo macht es auch Spass..
Auch dir schöne Feiertage - ich werde dich in mein Nachtgebet einschließen (grins)
Margarete

AW: genau,
24.03.2016 14:46:20
Michael
Hi Margarete,
schön, schön, und danke für das Nachtgebet (wer weiß, wofür's gut ist).
Wenn ich mir Deine Anforderungen so ansehe, drängt es mich, Dir ganz allgemein gesprochen das Zitat auf den Weg zu geben:
[…] I'm a huge proponent of designing your code around the data, rather than the other way around […] I will, in fact, claim that the difference between a bad programmer and a good one is whether he considers his code or his data structures more important. Bad programmers worry about the code. Good programmers worry about data structures and their relationships.
Zitiert nach: https://en.wikiquote.org/wiki/Linus_Torvalds
Torvalds hat das Linux programmiert.
Soll heißen: spätestens, wenn die Funktionen zu komplex werden, sollte man sich über die Datenstrukturen Gedanken zu machen.
Typische Stichworte zu Datenbanken sind "Normalisierung", "Redundanz", und einige der Gedanken können auch die Arbeit mit Excel befruchten.
Frohes Schaffen & schöne Grüße,
Michael

AW: genau,
24.03.2016 19:28:20
MB12
Hallo Michael,
nach diesem Zitat müsste ich ja ein "good programmer" sein - lol
Bei jeder Version durchforste ich die Datei mit einem Eisenbesen, was rausgeworfen werden kann. Aber es verhält sich ähnlich wie Abmagerungskuren: Nicht lange nach Beendigung wird alles noch dicker..
Soweit der Spruch zum Feiertag.
Gruß, Margarete

AW: genau,
26.03.2016 14:18:46
Michael
Hallo Margarete,
ja, ja, nach einiger Zeit der Benutzung schleicht sich gerne ein gewisser Wildwuchs ein, hehe.
Naja, der Programmierer lernt vom Anwender und der Anwender vom Programmierer (die ganzen "/-In" denkst Du Dir bitte): eigentlich wird man nie ganz fertig. Welcher Grieche war das mit dem "alles fließt"? Aha, Heraklit: panta rhei.
Gruß zurück,
Michael

AW: und hier die Datei
23.03.2016 13:07:44
MB12
Hallo Michael,
kleines Erfolgserlebnis: durch testen und mehrfaches anpassen deines Makros habe ich tatsächlich die Lösung gefunden zum Erzeugen eines neuen Blattnamens nach dem Muster
Original: "AAA"
Kopie: "AAA2"
und das FitToPages eingefügt.
Jetzt könnte ich natürlich zufrieden sein, aber ich wollte auch herausfinden , wie ich anstatt mit Zellbezug mit dem Vergleich der Blattnamen die Kopie ansprechen kann (wie von Herbert vorgeschlagen).
Bin leider gescheitert :-(
Sub MakroDruck2()
Dim iActiveSheetNr%, iCount%, sPrüfText$, a%, sTab1$, sTab2$
iActiveSheetNr = ActiveSheet.Index
iCount = Sheets.Count
For a = iActiveSheetNr + 1 To iCount
If Sheets(a).Name = Sheets(iActiveSheetNr & "2").Name Then   'funktioniert nicht
With Sheets(iActiveSheetNr)
.PageSetup.PrintArea = "$A$1:$K$70"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA3
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With
With Sheets(a)
.PageSetup.PrintArea = "$A$1:$D$55"
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
'           .PrintOut
End With
'        oder wenn ohne PrintOut wie gehabt
sTab1 = Sheets(iActiveSheetNr).Name
sTab2 = Sheets(a).Name
Sheets(Array(sTab1, sTab2)).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(iActiveSheetNr).Select
Exit Sub
End If
Next a
End Sub
(im Modul Modul1_TabNamen_vergleichen)
Könntest du vielleicht drüberschaun?
Hier die Datei: https://www.herber.de/bbs/user/104559.xlsm
Der funktionierende Code ist im Modul1_Druck_Zellvergleich
Herzlichen Dank für deine Mühe
Margarete

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige