Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Kontrollkästchen automatisch markieren lassen

Betrifft: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 09:59:05

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

  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Rudi Maintaire
Geschrieben am: 18.07.2008 10:22:50

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 10:36:17

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Rudi Maintaire
Geschrieben am: 18.07.2008 10:50:13

Hallo,
hab kein xl97 und kann nicht testen.

Versuchs mit

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



Gruß
Rudi


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 10:56:22

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Matthias L
Geschrieben am: 18.07.2008 11:13:08

Hallo

hier mal eine Alternative zum probieren.

https://www.herber.de/bbs/user/53937.xls

Gruß Matthias


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 11:27:19

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 11:13:27

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Rudi Maintaire
Geschrieben am: 18.07.2008 12:49:20

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


  

Betrifft: AW: Kontrollkästchen automatisch markieren lassen von: Bernd Junker
Geschrieben am: 18.07.2008 14:40:56

Das Problem war ja auch nur, daß wenn man keine Ahnung von VBA hat, auch nicht wissen kann, wofür die Zahlen sind ;-)


 

Beiträge aus den Excel-Beispielen zum Thema "Kontrollkästchen automatisch markieren lassen"