Thema Datum  Von Nutzer Rating
Antwort
15.04.2014 10:15:38 Corina
NotSolved
15.04.2014 12:54:44 Holger
NotSolved
15.04.2014 13:32:53 Gast15716
NotSolved
15.04.2014 18:38:46 Gast68648
NotSolved
15.04.2014 18:42:31 Gast74327
NotSolved
15.04.2014 18:57:47 Gast86647
NotSolved
16.04.2014 09:08:55 Corina
NotSolved
16.04.2014 09:10:04 Corina
NotSolved
16.04.2014 11:05:14 Gast61557
NotSolved
16.04.2014 11:06:26 Gast56441
NotSolved
16.04.2014 13:40:21 Corina
NotSolved
17.04.2014 10:39:35 Gast28994
NotSolved
Rot Abgleich CheckBox-Namen mit Spalteneinträge
17.04.2014 10:39:52 Gast89598
*****
Solved
17.04.2014 14:46:07 Corina
NotSolved
17.04.2014 15:28:44 Gast83463
NotSolved
17.04.2014 16:47:15 Corina
NotSolved
17.04.2014 17:31:38 Gast83279
NotSolved

Ansicht des Beitrags:
Von:
Gast89598
Datum:
17.04.2014 10:39:52
Views:
1876
Rating: Antwort:
 Nein
Thema:
Abgleich CheckBox-Namen mit Spalteneinträge

Ok, los gehts mit der Beschreibung für den "With"-Block (zumindest das war er bewirken soll). Für jedes Shape, welches sich im Arbeitsblatt "Checklist Structure" soll geprüft werden, ob das eine Check Box des Typus Form Control ist. Wenn ja, dann soll ihr Name mit den vorhandenen Einträgen der Spalte G im Arbeitsblatt "Risk Category Structure" abgeglichen werden. Wenn der Name der Check Box vorhanden ist, dann soll das Kästchen aktiviert werden, wenn nicht, dann deaktiviert werden. Diese Vorgehensweise soll wiederholt werden, bis keine Checkboxen mehr übrig sind...

 

Ok. Der fett markierte Teil stimmt nicht mit dem überein was da steht bzw. ist gar nicht vorhanden.

Du willst doch prüfen ob die Bezeichnung (angezeigte Name) dieses Shapes 'shp'in Spalte G vorhanden ist. Also kommt dort eine leicht modifizierte Version von dem unter diesem Link geposteten Code:

Hier ist er noch mal:

Sub RangeFind_Beispiel()
   
  Dim rng As Excel.Range
  Dim rngErg As Excel.Range
   
  Set rng = Columns("G") 'bzw. Range("G:G")
   
  'LookIn := xlValues ... in den Zelleninhalt soll geschaut werden
  'LookAt := xlWhole  ... gesamte Zelleninhalt muss dem gesuchten Wert entsprechen
  Set rngErg = rng.Find("Suchwert", LookIn:=xlValues, LookAt:=xlWhole)
   
  'Wenn was gefunden wurde...
  If Not rngErg Is Nothing Then
    '... dann z.B. Ausgabe der Zelladresse
    Call MsgBox(rngErg.Address, vbInformation)
  End If
   
End Sub

Nun ist in dem aktuellen Fall der Suchwert kein konstante konstante Zeichenkette (String) mehr, sondern kommt von der CheckBox (der Bezeichner / angezeigte Name).

also wird daraus:

              Set rngErg = rng.Find(shp.OLEFormat.Object.Caption, LookIn:=xlValues, LookAt:=xlWhole)
              
              '>>
              If Not rngErg Is Nothing Then
                shp.OLEFormat.Object.Value = True
              Else
                shp.OLEFormat.Object.Value = False
              End If
              '<< ODER der If-Block kürzer geschrieben >>
              shp.OLEFormat.Object.Value = Not rngErg Is Nothing
              '<<

 

Dies kommt jetzt in das innerste der If-Blöcke.

Final also so (Namen auf deine jetzt umgeändert):

Private Sub CompareCheckboxNames()
Dim ws As Worksheet
Dim rng As Excel.Range
Dim rngRes As Excel.Range
Dim shp As Shape
  
On Error GoTo ErrHandler
 
Set ws = Worksheets("Risk Category Checklist")
Set rng = ws.Range("G:G")

With Worksheets("Checklist Structure")
  
     For Each shp In .Shapes
        If shp.Type = msoFormControl Then
            If shp.FormControlType = xlCheckBox Then
              
              Set rngRes = rng.Find(shp.OLEFormat.Object.Caption, LookIn:=xlValues, LookAt:=xlWhole)
              
              '>>
              If Not rngRes Is Nothing Then
                shp.OLEFormat.Object.Value = True
              Else
                shp.OLEFormat.Object.Value = False
              End If
              '<< ODER der gesamte If-Block kürzer geschrieben >>
              'shp.OLEFormat.Object.Value = Not rngRes Is Nothing
              '<<

'            Exit For
            End If
        End If
    Next
End With
 
Exit Sub
 
ErrHandler:
  Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.number)
      
End Sub

Warum das Exit-For dort steht weiß ich nicht, es gehört ansich nicht dorthin (daher auskommentiert).


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
15.04.2014 10:15:38 Corina
NotSolved
15.04.2014 12:54:44 Holger
NotSolved
15.04.2014 13:32:53 Gast15716
NotSolved
15.04.2014 18:38:46 Gast68648
NotSolved
15.04.2014 18:42:31 Gast74327
NotSolved
15.04.2014 18:57:47 Gast86647
NotSolved
16.04.2014 09:08:55 Corina
NotSolved
16.04.2014 09:10:04 Corina
NotSolved
16.04.2014 11:05:14 Gast61557
NotSolved
16.04.2014 11:06:26 Gast56441
NotSolved
16.04.2014 13:40:21 Corina
NotSolved
17.04.2014 10:39:35 Gast28994
NotSolved
Rot Abgleich CheckBox-Namen mit Spalteneinträge
17.04.2014 10:39:52 Gast89598
*****
Solved
17.04.2014 14:46:07 Corina
NotSolved
17.04.2014 15:28:44 Gast83463
NotSolved
17.04.2014 16:47:15 Corina
NotSolved
17.04.2014 17:31:38 Gast83279
NotSolved