Daten Übertragung mit Dialogfenster und Abfrage

[schauan]

Hallöchen,

hier mal der angepasste code für den Druckbereich. Ich habe aus dem Sprengstoff C4 jetzt C9 gemacht, damit geht's bis Spalte I, und "Print_Area" Durch "Druckbereich" ersetzt.

Sub DruckBereich()
ActiveWorkbook.Names.Add Name:="Druckbereich", RefersToR1C1:= _
"='Label Bsp'!R2C1:R" & Cells(Rows.Count, 2).End(xlUp).Row & "C9"
End Sub

[Pirat2015]

keine Änderung, beim ausdrucken, werden alle 20 seiten wo die vorlagen drauf sind mit ausgedruckt.

[Steffl]

Nochmals Hallo,

mein letzter Beitrag ist wohl etwas untergegangen?

Code:

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

Dim colCounter As Long
Dim RowCounter As Long
Dim multiplier As Long
Dim Rowmultier As Long

multiplier = 2
colCounter = 0
RowCounter = 0
Rowmultier = 0

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Zieldate oeffnen
Workbooks.Open Filename:="Pfad"
'Qelldatei wieder aktivieren
Windows("Tabelle1.xlsm").Activate
'Schleife ueber Listeneintraege - Zaehlung beginnt bei 0!
Dim druck As Variant
druck = MsgBox("Please print Label", vbYes)
For icnt1 = 0 To ListBox1.ListCount - 1
'Wenn Zeileneintrag gewaelt wurde, dann
If ListBox1.Selected(icnt1) Then
  '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
      '.Offset(, 12) = ListBox1.List(icnt1, 3) '4
      .Offset(, 12).Value = CInt(Split(ListBox1.List(icnt1, 3))(0)) / 1
      .Offset(, 12 + 1).Value = Split(ListBox1.List(icnt1, 3))(1)
      .Offset(, 28) = ListBox1.List(icnt1, 4) '5
      .Offset(, 6) = ListBox1.List(icnt1, 5) '6
      .Offset(, 29) = ListBox1.List(icnt1, 6) '7
      .Offset(, 30) = ListBox1.List(icnt1, 7) '8
      .Offset(, 31) = ListBox1.List(icnt1, 8) '9
      .Offset(, 23) = ListBox1.List(icnt1, 9) '10
      .Offset(, 38) = ListBox1.List(icnt1, 9) '10
      .Offset(, 24) = ListBox1.List(icnt1, 10) '11
      .Offset(, 22) = ListBox1.List(icnt1, 11) '12
      If InStr(.Cells(.Rows.Count, 62), "PF80...") > 0 Then
      .Offset(, 1) = ListBox1.List(icnt1, 13) '13
            Else
      .Offset(, 1) = ListBox1.List(icnt1, 12) '12
            End If
      '.Offset(, 1) = ListBox1.List(icnt1, 12) '13
      '.Offset(, 1) = ListBox1.List(icnt1, 13) '14
      'beginnt bei Zelle 7 = 0
      .Cells(.Rows.Count, -4) = "9"
      .Cells(.Rows.Count, 40) = "-"
      .Cells(.Rows.Count, 38) = "local"
      .Cells(.Rows.Count, 37) = "local"
      .Cells(.Rows.Count, 41) = Format(Date, "dd.mm.yyyy")
     
'mit diesen Code Abschnitt wird der Label bzw. Labels gefüllt
      druck = True
      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)
      sheet.Cells(Rowmultier + 3, multiplier) = ListBox1.List(icnt1, 2)
      sheet.Cells(Rowmultier + 4, multiplier) = ListBox1.List(icnt1, 3)
      sheet.Cells(Rowmultier + 5, multiplier) = ListBox1.List(icnt1, 14)
      sheet.Cells(Rowmultier + 6, multiplier) = ListBox1.List(icnt1, 11)
      sheet.Cells(Rowmultier + 7, multiplier) = ListBox1.List(icnt1, 9)
      sheet.Cells(Rowmultier + 7, multiplier + 2) = ListBox1.List(icnt1, 10)
      If colCounter < 1 Then
                        colCounter = colCounter + 1
                        multiplier = multiplier + 5
            Else
                        RowCounter = RowCounter + 1
                        colCounter = 0
                        multiplier = 2
                        Rowmultier = Rowmultier + 7
            End If
    '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
Unload Me
MsgBox "Done"
End Sub

vielleicht liegt ja hier der fehler.

setze dir mal in der ersten Codezeile bzw. von mir aus auch beim Next einen Haltepunkt. Drücke dann auf die F8-Taste. Bemerkst Du dann was?

[Pirat2015]

wenn ich auf next haltepunkt setze und mit f8 weiter mache, spring der code auf If ListBox1.Selected(icnt1) Then, dann wieder auf next

[Steffl]

Hallo,

und dann weiter auf die F8-Taste klicken.

[Pirat2015]

springt zwischen next und  If ListBox1.Selected(icnt1) Then

[Steffl]

Hallo,

wenn in der Listbox kein Eintrag selektiert ist, wird die Tabelle nicht gefüllt. Und das kannst Du eben durch weiteres Drücken der F8-Taste herausfinden. Wenn nie in den If-Zweig gesprungen wird, dann paßt dein Druckbereich nie.

[schauan]

Hallo Stefan,

meinerseits ist nix untergegangen. Ich hab nur erst mal die Fehler im Code für den Druckbereich ausgemerzt. Wenn der Druckbereich Label genannt wird dann wird das Blatt soweit es genutzt wird gedruckt, wenn man es nicht anders einschränkt, z.B. Druck der Auswahl. Der Druck muss in der deutschen Version Druckbereich heißen, aufzeichnen tut Excel aber leider und fälschlicherweise Print_Area. In englisch würde es damit laufen...

Das mit der Datenübertragung aus der Listbox wäre dann Faust zweiter Teil. Da war ich erst mal bei den Daten auf dem Blatt

[Steffl]

Hallo André,

das passt aber nicht, wenn das Tabellenblatt Label nicht aktiv ist. Siehe die Antwort vom TE

keine Änderung, beim ausdrucken, werden alle 20 seiten wo die vorlagen drauf sind mit ausgedruckt.

da gehört zumindest vor dem Cells noch das Worksheet.

Code:

Sub DruckBereich()
ActiveWorkbook.Names.Add Name:="Druckbereich", RefersToR1C1:= _
"='Label Bsp'!R2C1:R" & Worksheets("Label Bsp").Cells(Rows.Count, 2).End(xlUp).Row & "C9"
End Sub

[Kuwer]

Hallo André,

Der Druck muss in der deutschen Version Druckbereich heißen, aufzeichnen tut Excel aber leider und fälschlicherweise Print_Area. In englisch würde es damit laufen...

das kann ich so nicht stehen lassen.  :21:

Code:

Sub Makro2()
  With ActiveSheet
    .PageSetup.PrintArea = .UsedRange.Address
    Debug.Print .Names("Print_Area").Name
    Debug.Print .Names("Print_Area").NameLocal
    Debug.Print .Names("Druckbereich").Name
    Debug.Print .Names("Druckbereich").NameLocal
  End With
End Sub

Gruß Uwe