Daten Übertragung mit Dialogfenster und Abfrage
Hi Uwe,

bei mir geht es auch um meine Variante mit Names und nicht die mit PrintArea. Ich versuche ja immer zu vermitteln, das man mit Aufzeichnen auch einiges lösen kann, was in dem Fall eben nicht passt.

Hi Stefan,

in der Beispieldatei gibt es doch nur ein Blatt, oder hab ich da einen Upload mit mehreren übersehen? Als Vorlage fasse ich die Teile / Druck-"Seiten" des Blattes auf, die nur in Spalte A vorgefüllt sind. Für ein anderes aktives Blatt müsste dann eine andere Datei offen sein.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
Hallo André,

(18.06.2020, 09:27)schauan schrieb: in der Beispieldatei gibt es doch nur ein Blatt, oder hab ich da einen Upload mit mehreren übersehen?

Wenn man den Code vom TE anschaut, würde ich das verneinen (ich habe einige Zeilen gelöscht, die für das Verständnis nicht entscheidend sind)

Code:
Private Sub CommandButton1_Click()
'Variablendeklarationen - Integer (%)
Dim icnt1%
Dim sheet As Worksheet

'Zieldate oeffnen
Workbooks.Open Filename:="Pfad"
'Qelldatei wieder aktivieren
Windows("Tabelle1.xlsm").Activate

  'Mit dem Zielblatt
  With Workbooks("Tabelle1").Sheets("Test1")
    'mit der ersten lleren Zelle (anhand Spalte 7)
    With .Cells(.Cells(.Rows.Count, 7).End(xlUp).Row + 1, 7)
      'Eintraege der Listbox uebernehmen, Spalten 4 bis 7 - Zaehlung beginnt bei 0!
      .Value = ListBox1.List(icnt1, 0)
      .Offset(, 1) = ListBox1.List(icnt1, 1) '2
      .Offset(, 4) = ListBox1.List(icnt1, 2) '3
     
'mit diesen Code Abschnitt wird der Label bzw. Labels gef?llt
      Set sheet = ActiveWorkbook.Sheets("Label")
      'label zellen
      sheet.Cells(Rowmultier + 1, multiplier) = ListBox1.List(icnt1, 12)
      sheet.Cells(Rowmultier + 2, multiplier) = ListBox1.List(icnt1, 1)
    'Ende mit der ersten lleren Zelle (anhand Spalte 6)
    End With
  'Ende Mit dem Zielblatt
  End With
'Ende Wenn Zeileneintrag gewaelt wurde, dann
End If
Next
Unload Me
      Call DruckBereich
      Tabelle1.PrintPreview
      Dim labelrange As Range
      Set labelrange = sheet.Range("B1:D1000,G1:I100")
      labelrange.ClearContents
'Zieldatei aktivieren
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Windows("Tabelle1").Activate
End Sub

er öffnet eine Datei, aktiviert wieder die Makrodatei, und da sind es für mich zwei Tabellenblätter.
Gruß Stefan
Win 10 / Office 2016
Top
Hallo Zusammen,

ja die Labels befinden sich in der andere Tabelle aber in derselben Excel Datei.
Bsp. Datei war nur um zu verstehen wie die Label vorlagen aufgabt sind.
Top
Hi André,

(18.06.2020, 09:27)schauan schrieb: bei mir geht es auch um meine Variante mit Names und nicht die mit PrintArea. Ich versuche ja immer zu vermitteln, das man mit Aufzeichnen auch einiges lösen kann, was in dem Fall eben nicht passt.

ich hoffte, dass Du selber erkennst, wie gruselig Deine Variante ist. Wink
Druckbereiche sind nämlich lokale Namen. Sie beginnen also mit dem Blattnamen und anschließendem Ausrufezeichen. Enthält der Blattname aber z.B. Leerzeichen, kommen noch Hochkommas drumherum. Und dann kommt erst der eigentliche lokalisierte Name.  Blush

Wenn ich das Festlegen des Druckbereiches aufzeichne, wie Du es ja in #86 empfiehlst, erhalte ich so etwas:
ActiveSheet.PageSetup.PrintArea = "$B$2:$C$3"
Da ist der sich dahinter verbergende Name unwichtig. Wink

Gruß Uwe
Top
Hi Uwe,

das sind eben noch die alten Hackerfinger. Zwei Wege gibt's. Ich kann Druckbereich eben als Bereichsnamen eingeben und der ist dann auch nicht nur ein so benannter Bereich sondern ein Druckbereich, oder ich gehe oben über den Reiter ... Nur der eine Weg zeichnet einen im ersten Moment unbrauchbaren code auf, der mit Anpassung aber auch lauffähig ist.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
HiAndré,

(18.06.2020, 13:08)schauan schrieb: Nur der eine Weg zeichnet einen im ersten Moment unbrauchbaren code auf, der mit Anpassung aber auch lauffähig ist.

dann zeige doch bitte die richtige Anpassung.  Blush
Du hattest beim Aufzeichnen schon einen gravierenden Fehler gemacht! Wink

Gruß Uwe
Top
Hallöchen,

hier mal ein code, der in allen Blättern prüft, ob in Spalte B mehr steht als nur bis Zeile 1. Wenn ja, wird das Blatt in eine Liste genommen, der Druckbereich für dieses Blatt festgelegt und am Ende die betroffenen Blätter selektiert. Wenn man dann in die Seitenvorschau geht und daraus druckt, sollten auch nur die betroffenen / selektierten Blätter gedruckt werden. Ob die Daten korrekt in den Blättern stehen hab ich allerdings immer noch nicht angeschaut. Sad

Wenn die Labeltabelle eines Blattes komplett gedruckt werden soll, ohne Einstellung des Druckbereichs für dieses Blatt auf die gefüllten Daten, kann man die Codezeile auch auskommentieren bzw. löschen, siehe code unter "Druckbereich auf Blatt festlegen"

Wenn noch andere Blätter in der Datei sind außer "Label ...", kann man noch eine Prüfung hinzufügen, die nur Blätter mit Label am Anfang berücksichtigt.

Uwe, siehe #103 Smile

Code:
Sub BlaetterZumDrucken()
'Variablendeklarationen
Dim arrTemp, blaetter As Worksheet, iCnt%
'Array dimensionieren
ReDim arrTemp(Sheets.Count)
'Zaehler festlegen
iCnt = -1
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets
  'Mit einem Blatt
  With blaetter
    'Druckbereich auf dem Blatt festlegen
    'Wenn gefullter Bereich in SPalte B min. bis Zeile 2 geht, denn
    If .Cells(Rows.Count, 2).End(xlUp).Row > 1 Then
      'Blattzaehler hochsetzen
      iCnt = iCnt + 1
      'Blattname in Array uebernehmen
      arrTemp(iCnt) = .Name
      'Druckbereich auf Blatt festlegen
      .PageSetup.PrintArea = "='" & .Name & "'!" & .Range("A1:I" & .Cells(Rows.Count, 2).End(xlUp).Row).Address
    'Ende Wenn gefullter Bereich in SPalte B min. bis Zeile 2 geht, denn
    End If
  'Ende Mit einem Blatt
  End With
'Ende Schleife ueber alle Blaetter
Next
'Wenn min ein Blatt betroffen ist, dann
If iCnt >= 0 Then
'Array auf Anzahl betroffener Blaetter reduzieren
ReDim Preserve arrTemp(iCnt)
'Blattliste Selectieren
Sheets(arrTemp).Select
'Ende Wenn min ein Blatt betroffen ist, dann
End If
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • Pirat2015
Top
Gibt es hier eine Endlosschleife ?  Huh
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Top
Hi André,

(18.06.2020, 16:21)schauan schrieb: Uwe, siehe #103 Smile

der ist falsch, auch mit Stefans Korrektur/Ergänzung.  Undecided

Gruß Uwe
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 3 Gast/Gäste