Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
992to996
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
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kontrollkästchen automatisch markieren lassen

Kontrollkästchen automatisch markieren lassen
18.07.2008 09:59:05
Bernd
Hallo,
über einen User habe ich VBA-Code bekommen, den ich nach meinen Bedürfnissen erweitert bzw. geändert habe. Es geht darum, daß ich Angebote, Aufträge und Rechnungen immer in einer bestimmten Anzahl ausdrucken muß.
Über Kontrollkästchen kann ich entsprechend anwählen, was ausgedruckt wird.
Für ein Angebot brauche ich normalerweise (!!!) das Original und 3 Kopien, für einen Auftrag ebenfalls und für eine Rechnung das Original und 7 Kopien. Die Kopien werden entsprechend farbig und mit Text "KOPIE ..." gekennzeichnet.
Das Ganze sieht so aus:
http://img184.imageshack.us/img184/6186/screenshotexcellt4.jpg
Der VBA-Code sieht so aus:

Sub Drucken()
Dim objWks As Worksheet, strAktiverDrucker As String, objZelleKopie As Range
Dim lngFarbeKopie As Long
On Error GoTo Fehler
Set objWks = Worksheets("Angebot")
Set objZelleKopie = objWks.Range("F11") 'Zelle zur Kennzeichnung der Kopie
lngFarbeKopie = objZelleKopie.Interior.ColorIndex 'Originalfarbe merken
'Drucken
strAktiverDrucker = Application.ActivePrinter 'aktiven Druckermerken
'Drucker für Ausgabe setzen, falls nicht der Aktive Drucker genommen werden soll
Application.ActivePrinter = "Samsung CLP-300 Series auf Ne00:"
If objWks.Shapes("Kontrollkästchen 5").ControlFormat.Value = 1 Then
'Kunden-Exemplar
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 25").ControlFormat.Value = 1 Then
'Kopie - Kunde
objZelleKopie = "K O P I E"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 8").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 6 'gelb
objZelleKopie = "KOPIE - Produktion"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 29").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 3 'rot
objZelleKopie = "KOPIE - Tourenplanung"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 28").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 40 'hellgrau
objZelleKopie = "KOPIE - Ablage/Koffer"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 31").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Provisionsabrechnung"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 32").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Steuerberater"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 34").ControlFormat.Value = 1 Then
'Kopie - Produktion
objZelleKopie.Interior.ColorIndex = 4 'grün
objZelleKopie = "KOPIE - Zahlungsverkehr"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 6").ControlFormat.Value = 1 Then
'Kopie - Vertrieb
objZelleKopie.Interior.ColorIndex = 37 'hellblau
objZelleKopie = "KOPIE - Vertrieb"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 36").ControlFormat.Value = 1 Then
'Kopie - Vertrieb
objZelleKopie.Interior.ColorIndex = 33 'blau
objZelleKopie = "KOPIE - Lieferschein etc."
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 7").ControlFormat.Value = 1 Then
'Exemplar - Allgemeine Ablage
objZelleKopie.Interior.ColorIndex = 33 'blau
objZelleKopie = "KOPIE - Gesamt-Ordner"
'   objWks.PrintPreview
objWks.PrintOut
End If
If objWks.Shapes("Kontrollkästchen 9").ControlFormat.Value = 1 Then
'PDF-Datei erstellen
'FarbeZelle zurücksetzen
objZelleKopie.Interior.ColorIndex = lngFarbeKopie
objZelleKopie.MergeArea.ClearContents
'PDF-Drucker auswählen
Application.ActivePrinter = "Acrobat PDFWriter auf LPT1:"
objWks.PrintOut
End If
Fehler:
If Err.Number  0 Then
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End If
'FarbeZelle zurücksetzen
If Not objZelleKopie Is Nothing Then
objZelleKopie.Interior.ColorIndex = lngFarbeKopie
objZelleKopie.MergeArea.ClearContents
End If
'Drucker zurücksetzen
If strAktiverDrucker  "" Then Application.ActivePrinter = strAktiverDrucker
End Sub


Soweit, so gut .....
Nun wäre es aber noch optimaler, wenn die Kontrollkästchen automatisch markiert würden.
Beispiel für Angebote ... markiert werden müßten die Kontrollkästchen:
Kunde 1, Ablage Koffer, Vertrieb und Gesamt-Ordner
Beispiel für Aufträge ... markiert werden müßten die Kontrollkästchen:
Kunde 1, Ablage Koffer, Vertrieb, Produktion, Tourenplanung
Gibt es da irgendeine Lösung?
In Zelle B24 steht entweder "Angebot", "Auftrag" oder "Rechnung".
Vielleicht könnte man da mit VBA-Code eine Schleife aufbauen, die dann die entsprechenden Haken in die Kontrollkästchen setzt.
Voraussetzung müßte allerdings sein, daß ich trotzdem manuell noch weitere Haken setzen kann oder aber auch wieder Haken entfernen kann.
Es grüßt
Junker

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 10:22:00
Rudi
Hallo,
in den Code der Tabelle:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, arrControls, shp As Shape
If Target.Address = "$B$24" Then
Select Case Target.Text
'Checkboxen definieren
Case "Angebot":  arrControls = Array(2, 5, 8, 9)
Case "Rechnung": arrControls = Array(3, 5, 7, 9, 11)
Case "Auftrag": arrControls = Array(1, 5, 6, 7, 8, 11)
End Select
If IsArray(arrControls) Then
For Each shp In Me.Shapes 'alle Checkboxen auf False
If shp.FormControlType = xlCheckBox Then shp.ControlFormat.Value = 0
Next
For i = 0 To UBound(arrControls)  'Checkboxen setzen
Me.Shapes("Kontrollkästchen" & arrControls(i)).ControlFormat.Value = 1
Next i
End If
End If
End Sub


Gruß
Rudi

Anzeige
AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 10:36:00
Bernd
Hallo Rudi,
DANKE für die schnelle Antwort.
Ich bekomme leider den Laufzeitfehler '1004'.
Anwendungs- oder objektdefinierter Fehler
Im VBA-Editor wird dann gelb markiert:
If shp.FormControlType = xlCheckBox Then
Es grüßt
Junker

AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 10:50:00
Rudi
Hallo,
hab kein xl97 und kann nicht testen.
Versuchs mit

if shp.name like "Kontrollkästchen*" Then ...


Gruß
Rudi

AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 10:56:00
Bernd
Also
If shp.Name Like "Kontrollkästchen*" Then shp.ControlFormat.Value = 0
Laufzeitfehler '-2147024809 (80070057)"
Das Element mit dem angegebenen Namen wurde nicht gefunden
Im VBA-Code wird dann gelb unterlegt:
Me.Shapes("Kontrollkästchen" & arrControls(i)).ControlFormat.Value = 1
Gruß
Junker

Anzeige
AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 11:27:00
Bernd
Hallo Mathias,
in Deiner Beispieldatei klappt das so, wie ich es gerne auch hätte.
Bei mir gibt es aber keine CheckBox1, CheckBox2 etc., sondern "Kontrollkästchen 5" etc.
Wie muß ich dann z.B. CheckBox1.Value = False ändern?
Gruß
Junker

AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 11:13:00
Bernd
Sorry Rudi, kommt doch kein Fehler
Hatte zu Testzwecken aus dem "$B$24" ein ""$J$24" gemacht.
Trotzdem werden keine Haken gesetzt, egal, was in B24 steht.
Wofür ist denn eigentlich
Case "Rechnung": arrControls = Array(3, 5, 7, 9, 11)
zuständig?
Soll die 11 z.B. für "Kontrollkästchen 11" stehen?
Ein "Kontrollkästchen 11" haben ich nämlich nicht.
Gruß
Junker

Anzeige
AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 12:49:20
Rudi
Hallo,

Soll die 11 z.B. für "Kontrollkästchen 11" stehen?


exakt!


Ein "Kontrollkästchen 11" haben ich nämlich nicht.


Hellsehen kann ich nicht. Du musst dir den Code schon an deine Mappe anpassen.
Gruß
Rudi

AW: Kontrollkästchen automatisch markieren lassen
18.07.2008 14:40:00
Bernd
Das Problem war ja auch nur, daß wenn man keine Ahnung von VBA hat, auch nicht wissen kann, wofür die Zahlen sind ;-)

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige