Daten Übertragung mit Dialogfenster und Abfrage

[Pirat2015]

Also ich habe jetzt den Code in den Modul rein geschrieben und in code " call DruckBereich" abgeändert jetzt bekomme ich folgende fehler:

"anwendung oder Objekt defenierter fehler"

Hier die zwei Codes

Code in Module

Code:

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

Dazu noch eine Frage was bedeutet das; ActiveWorkbook.Names.Add Name:="Print_Area", RefersToR1C1:= und das "C4"

Haupt Code

Code:

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

Danke

[schauan]

Hallöchen,

ich hatte geschrieben, dass ich einen Druckbereich definiert hatte. Ich hatte ihn beim Aufzeichnen gelöscht, bevor ich ihn neu definiert hatte. Wenn Du noch keinen hast, kommt der Fehler. Muss man aber nicht machen, die Zeile kann raus.

C4:
ich hatte es zu "C1" erklärt:
Spalte A (C1 / Spalte 1 = A) l
Wenn 1 = A ist wäre 4 dann ?

[Pirat2015]

Sorry aber ich checke es nicht was ich schreiben soll.
könntest du mir den Code schreiben.

Meine Rage sind A1:D7, label2 ist F1:I7, Label3 A8:D14, Label4 F8:I14 und so weiter.

Danke dir

[schauan]

Hallöchen,

also, zur Erklärung. C4 bedeutet Colum 4 bzw. Spalte 4 bzw. Spalte D


Hier sollst Du die Zeile zum Löschen weglassen.

Code:

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

Das wäre dann

Code:

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

[Pirat2015]

und das hier

Code:

"='Label Bsp'!R2C1:R"

[schauan]

Hallöchen,

das ist aber auch nicht schwer ...

Label Bsp
ist der Blattname. Der wird von Hochkommas eingeschlossen, ist so geregelt.
'Label Bsp'
Das Ausrufezeichen
!
trennt den Blattname von der Zelladressangabe
R2C1:R

Die zum zweiten R gehörende Zeilennummer wird ermittelt mit
Cells(Rows.Count, 2).End(xlUp).Row

und die & verbinden die Zeichenketten.

[Pirat2015]

ich verzweifle mit diesen Thema.

Ich habe das jetzt so angepasst:

Code:

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

es passiert nichts und hier  wird der Wert Cells(Rows.Count, 2) = 1048576 angezeigt, was bedeute das.

[Steffl]

Hallo,

ich verzweifle mit diesen Thema.

es passiert nichts und hier  wird der Wert Cells(Rows.Count, 2) = 1048576 angezeigt, was bedeute das.

Wieviele Zeilen hat deine Exceltabelle zur Verfügung?

Und wahrscheinlich ist bei der Codeausführung das Tabellenblatt Label1 nicht aktiv.

Code:

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

[schauan]

Hallöchen,

passiert denn wirklich nix bzw. was erwartest Du an der Stelle? Hast Du Daten in Spalte B hinzugefügt oder am Ende gelöscht und dann den Druckbereich auf dem Blatt geprüft? Wenn sich an den Daten nix ändert, ändert sich auch der Druckbereich nicht. Geprüft wird hier, wie ich irgendwo schon schrieb, anhand der Eintragungen in Spalte 2 (B)

Cells(Rows.Count, 2).End(xlUp).Row stellt anhand des ausgefüllten Bereiches von Spalte B fest, wo die letzte ausgefüllte Zelle (Zeilennummer) ist. Das ist die VBA-Variante von STRG+Up aus der letzten Zeile heraus

Du kannst zum Test auch einen pdf-Drucker auswählen und die Datei als pdf ausdrucken, das verschwendet weder Papier noch Tinte

Problematisch wäre es, wenn Du die Daten in Spalte B per Formel einträgst oder inzwischen auf eine Liste umgestellt hast. Das war in Deinem Beispiel in #84 beides noch nicht der Fall.

[Pirat2015]

Code:

roblematisch wäre es, wenn Du die Daten in Spalte B per Formel einträgst

ich fülle die Labels Vorlage mit einen VBA code, also den welchen wir zusammen erstellt haben:). Ich habe diesen etwas verändert:)

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.