Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1312to1316
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

Matrix für Etikettenausdruck

Matrix für Etikettenausdruck
16.05.2013 07:16:54
Albert
Guten Morgen zusammen,
ich hab mich naiverweise mit einem Etikettendruck auseinander zu setzen und hierbei bräuchte ich eure Hilfe.
Das Problem ist folgendes...
Ich muss aus einer Exceletikettenvorlage heraus drucken und hab zur Verdeutlichung eine Datei angehängt.
Der Ablauf ist wie folgt. Ich wähle über eine Userform aus, wie viele Etiketten auf dem Trägerpapier vorhanden sind. Anschließend mit einer Checkbox, welche Abteilung ein Etikett bekommt.
Da zwei Abteilungen nicht auf ein Etikett gedruckt werden können, muss hier eine Bedingung herrschen, bei der ich bis jetzt nicht weiter gekommen bin.
Die Matrix in der angehängten Datei zeigt in der zweiten Zeile, welche Etiketten auf dem Bogen verfügbar sind. Anschließend soll die Auswahl der Abteilung entsprechend ein Etikett bekommen, heißt, dass z.B. ein "x" die Etikettnummer angibt.
Wär euch um Hilfe echt dankbar.
https://www.herber.de/bbs/user/85347.xlsm
Dank und Gruß
A.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Matrix für Etikettenausdruck
16.05.2013 07:31:39
Albert
Hi...
ich bastle grad an dem Codeschnipsel rum, doch wie hält man die Etikettenbelegung auf dem Druckbogen dynamisch?
Private Sub checkbox1_click()
If CheckBox1.Value = True Then
Select Case WorksheetFunction.CountA(Range("L19:N19"))
Case 0: Range("L19") = Range("U1")
Case 1: Range("M19") = Range("U1")
Case 2: Range("N19") = Range("U1")
Case 3: MsgBox "Auswahl nicht mehr möglich!"
End Select
End If
If CheckBox1.Value = False Then
Sheets("Etikettenbelegung").Range("A3:H3").Select
Selection.ClearContents
End Sub
Gruß
A.

AW: Matrix für Etikettenausdruck
16.05.2013 08:10:21
Matthias
Hallo
Es ist kein Programmcode in der Datei auch kein UForm,
Dafür aber ein automatischer Hyperlink.
Du solltest bei Deinem Level wenigstens auf SELECT verzichten
    Sheets("Etikettenbelegung").Range("A3:H3").Select
Selection.ClearContents

    Sheets("Etikettenbelegung").Range("A3:H3").ClearContents

sollte doch reichen.
Gruß Matthias

Anzeige
AW: Matrix für Etikettenausdruck
16.05.2013 08:25:15
fcs
Hallo Albert,
momentan sind deine Fragen noch irgendwie etwas konfus.
... doch wie hält man die Etikettenbelegung auf dem Druckbogen dynamisch?
Was meinst du damit?
Ich gehe bei Ettiketten fast immer den Weg über die Ettiketten-/Serienbrieffunktion von Word und benutze Excel ggf. um die Daten für die Ettiketten in Form einer Liste aufzubereiten, die Datenquelle für Word dient.
Gruß
Franz

AW: Matrix für Etikettenausdruck
16.05.2013 08:37:51
Albert
Moin Matthias, moin Franz,
entschuldigt, falls ich mich konfus ausgedrückt hab.
Dynamisch halten heißt, dass zwar acht Etiketten vorhanden sein können, aber es auch 6, 5 oder 3 sein können.
Was ich bräuchte ist ein Makro, welches mir in Abhängigkeit der Etikettenanzahl prüft, ob das nächste Etikett leer ist.
Schematisch beschrieben in der Tabelle:
Fall 1:
Wenn in A2 ein "x" steht und darunter zu keiner Abteilung, dann setze in Spalte A für die entsprechende Abteilung ein "x".
Fall 2:
Wenn in A2 ein "x" steht, aber bereits eine Abteilung ein "x" hat, dann nehme die Spalte B für die gewünschte Abteilung
Fall 3:
Wenn in A2 KEIN "x" steht, sondern in B2, dann prüfe Fall 1 und Fall 2.
Ich hoff, ich konnte mein Problem besser beschreiben.
Dank schon jetzt mal und Gruß
A.

Anzeige
AW: Matrix für Etikettenausdruck
16.05.2013 12:04:02
fcs
Hallo Albert,
deine Logik kann ich immer noch nicht nachvollziehen.
Für stellt es siche wie folgt da:
1. Prüfe ob in Zelle A2 ein "x" steht
1.1 Wenn "Ja" dann
2 Prüfe ob in A3:A14 schon ein "x" steht
2.1 Wenn "Nein" dann suche die Abteilung in I3:I14
2.1.1 Trage in der Zeile in Spalte A ein "x" ein
2.2 Wenn "Ja", dann
2.2.1 Wiederhole die Schritte ab 1 für Spalte B bis H
1.2 Wenn "Nein"
1.2.1 Wiederhole die Schritte ab 1 für Spalte B bis H
Ich hab das mal makromäßig umgesetzt.
Gruß
Franz
Sub Test()
Call Mark_Ettiket(strAbteilung:="Abteilung 1") '"Abteilung 1" durch entsprechende _
Variable/Steuerelement-Eigenschaft ersetzen
End Sub
Sub Mark_Ettiket(strAbteilung)
Dim wks As Worksheet, Spalte As Long, bolMarkiert As Boolean, varZeile As Variant
Set wks = Worksheets("Tabelle1")
With wks
'in Zeile 2 auf "x"-Eintrag prüfen
For Spalte = 1 To 8 'Spalte A bis H
If UCase(.Cells(2, Spalte).Value) = "X" Then
'Prüfen, ob unterhalb schon ein "x" eingetragen
If Application.WorksheetFunction.CountIf(.Range(.Cells(3, Spalte), _
.Cells(14, Spalte)), "x") = 0 Then
'Zeile der Abteilung suchen
varZeile = Application.Match(strAbteilung, _
.Range(.Cells(3, 9), .Cells(14, 9)), 0)
If Not IsError(varZeile) Then
'Markierung eintragen
.Cells(3, Spalte).Offset(varZeile - 1, 0).Value = "x"
MsgBox "Ettiket " & Spalte & " ist verfügbar" 'Meldung - Testzeile
bolMarkiert = True
Exit For
Else
MsgBox "Abteilung """ & strAbteilung & """ in Bereich I3:I14 nicht gefunden!"
GoTo Beenden
End If
End If
End If
Next Spalte
If bolMarkiert = False Then
MsgBox "Kein freies Ettiket mehr"
End If
End With
Beenden:
End Sub

Anzeige
AW: Matrix für Etikettenausdruck
16.05.2013 13:48:30
Albert
Servus Franz,
ich hab nachfolgenden Code mal zusammengebastelt...
Private Sub Checkbox2_Click()
If CheckBox2.Value = True Then
If Sheets("Etikettenbelegung").Range("A2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets("Etikettenbelegung").Range("A3:A14") _
, "x") = 0 Then
Sheets("Etikettenbelegung").Range("A4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("B2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets("Etikettenbelegung").Range(" _
B3:B14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("B4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("C2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets("Etikettenbelegung") _
.Range("C3:C14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("C4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("D2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets("Etikettenbelegung") _
.Range("D3:D14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("D4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("E2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets(" _
Etikettenbelegung").Range("E3:E14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("E4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("F2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets(" _
Etikettenbelegung").Range("F3:F14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("F4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("G2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets(" _
Etikettenbelegung").Range("G3:G14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("G4").Value = "x"
End If
Else
If Sheets("Etikettenbelegung").Range("H2").Value = "x" Then
If Application.WorksheetFunction.CountIf(Sheets(" _
Etikettenbelegung").Range("H3:H14"), "x") = 0 Then
Sheets("Etikettenbelegung").Range("H4").Value = "x"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If CheckBox2.Value = False Then
Range("A4:H4").ClearContents
End If
End Sub
Dummerweise, wenn bereits in der Matrix ein "x" für eine Abteilung vorhanden ist, springt das Makro zum Ende... Wo ist mein Denkfehler.
Zu deinem Code...
Wie muss ich deinen Code umschreiben, dass ich ihn hinter eine Checkbox stecken kann?
Dank und Gruß
A.

Anzeige
AW: Matrix für Etikettenausdruck
16.05.2013 17:47:55
fcs
Hallo Albert,
du hast du beim Schachteln der Prüfbedingungen vertan.
Hier meine Variante etwas angepasst für deinen Makro-Start per Klick auf Checkbox (aus Active-X-Steuerelemente)
Gruß
Franz
Private Sub Checkbox1_Click()
If CheckBox1.Value = True Then
Call Mark_Ettiket(lngZeileAbteilung:=3) 'für andere Checkboxen 3 durch entsprechende Zeile  _
ersetzen
Else
Range("A3:H3").ClearContents
End If
End Sub
Private Sub Checkbox2_Click()
If CheckBox2.Value = True Then
Call Mark_Ettiket(lngZeileAbteilung:=4) 'für andere Checkboxen 4 durch entsprechende Zeile  _
ersetzen
Else
Range("A4:H4").ClearContents
End If
End Sub
Sub Mark_Ettiket(lngZeileAbteilung As Long)
Dim wks As Worksheet, Spalte As Long, bolMarkiert As Boolean, varZeile As Variant
Set wks = ActiveSheet 'Worksheets("Etikettenbelegung")
With wks
'in Zeile 2 auf "x"-Eintrag prüfen
For Spalte = 1 To 8 'Spalte A bis H
If UCase(.Cells(2, Spalte).Value) = "X" Then
'Prüfen, ob unterhalb schon ein "x" eingetragen
If Application.WorksheetFunction.CountIf(.Range(.Cells(3, Spalte), _
.Cells(14, Spalte)), "x") = 0 Then
'Markierung eintragen
.Cells(lngZeileAbteilung, Spalte).Value = "x"
MsgBox "Ettiket " & Spalte & " ist verfügbar" 'Meldung - Testzeile
bolMarkiert = True
Exit For
End If
End If
Next Spalte
If bolMarkiert = False Then
MsgBox "Kein freies Ettiket mehr"
End If
End With
Beenden:
End Sub

Anzeige
AW: Matrix für Etikettenausdruck
17.05.2013 07:42:33
Albert
Moin Franz,
das klappt ja wunderbar!
Vielen herzlichen Dank für deine Hilfe.
Gruß und schönes Wochenende
A.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige