MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 13.02.2018, 07:09   #1
Kinimod1984
Neuer Benutzer
Neuer Benutzer
Standard VBA - Klassenereignis aus Modul aufrufen

Liebes Forum

Hab mal wieder eine ziemlich banale Frage, jedoch nach Stunden und Tagen der nicht erfolggekrönten Suche keine Antworten gefunden.

Ich erstelle in einem Frame ein paar Labels:

Klassenmodul:

Code:

Option Explicit

Public WithEvents Label As MSForms.Label

Sub Label_Click()
    
    Dim ctl As Control
    
    For Each ctl In Userform1.Frame1.Controls
        If TypeName(ctl) = "Label" Then
            ctl.ForeColor = vbBlack
            ctl.BackColor = vbWhite
        End If
    Next ctl
    
    Range("A1").Value = Label.Caption
    Label.BackColor = vbBlack
    Label.ForeColor = vbWhite
    
End Sub

Sub add()

    If Label.Caption = "Maestro" Then
        Worksheets("Tabelle1").Range("J2").Value = "Hello"
    End If

End Sub
Ein Modul:

Code:

Option Explicit
Public cLabel() As New clsLabel
Userform-Prozedur (Initialisierung):

Code:

Private Sub UserForm_Initialize()

Dim LB As Control
Dim LabelCount1 As Integer
Dim i As Long
Dim t As Long
Dim ALetzte As Long
ALetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
t = 0
For i = 8 To ALetzte
    Set LB = Userform1.Frame1.add("Forms.Label.1", Range("A" & i).Value, True)
    With LB
        .Top = t
        .Left = 0
        .Width = 130
        .Caption = Range("A" & i).Value
        .ForeColor = Range("A" & i).Font.Color = vbBlack
        .Font.Size = 12
    End With
    LabelCount1 = LabelCount1 + 1
    ReDim Preserve cLabel(1 To LabelCount1)
    Set cLabel(LabelCount1).Label = LB
t = t + 18
Next i
Nun zur eigentlichen Frage:

Gerne möchte ich mittels einem cmd auf der UF die "add"-Prozedur im Klassenmodul aufrufen.

Mit:

Code:

Private Sub CommandButton2_Click()
 
Call add

End Sub
will es natürlich nicht gehen - hat vielleicht jemand eine Idee? Vielen Dank bereits im Voraus!
Kinimod1984 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 09:11   #2
EarlFred
MOF Guru
MOF Guru
Standard

Hallo,

von welchem der vielen Labels willst Du denn die Add-Methode aufrufen, wenn Du 34 Labels in Deinem Array hast? Ist das egal? Oder eher nicht, wie der dahinterliegende Code vermuten lässt?

Bei einem beliebigen (es wird immer das erste Label im Datenfeld cLabel genommen):
Code:

Private Sub CommandButton1_Click()
If LBound(cLabel, 1) > -1 Then Call cLabel(LBound(cLabel, 1)).add
End Sub
Diese Zeile gibt mir Rätsel auf:
.ForeColor = Range("A" & i).Font.Color = vbBlack

Range("A65536")... diese Zeilengrenze ist seit langem aufgehoben. Verwende Rows.Count.

Ich würde auch nicht wahllos alles Controls durchlaufen, sondern gezielt die Labels in Deiner Feldvariable:
Code:

Sub Label_Click()
    
    Dim i As Long
    
    For i = LBound(Modul1.cLabel, 1) To UBound(Modul1.cLabel, 1)
      Modul1.cLabel(i).Label.ForeColor = vbBlack
      Modul1.cLabel(i).Label.BackColor = vbWhite
    Next i
    
    Range("A1").Value = Label.Caption
    Label.BackColor = vbBlack
    Label.ForeColor = vbWhite
    
End Sub
Diesen Artikel kennst Du?
Der Alte Mann und die Frames - oder Ordnung ist langsam?

Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 3 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,023% per 05.12.2017) - eine tolle Geste!

Geändert von EarlFred (13.02.2018 um 09:33 Uhr).
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 12:07   #3
Kinimod1984
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Lieber EarlFred

Ganz herzlichen Dank für die prompte Rückmeldung.

Der Instanzaufruf funktioniert zwar, allerdings nicht mit der Bedingung, dass nur in die Zelle geschrieben wird, wenn das selektierte Label die Caption = "Maestro" aufweist.

Zielzustand wäre, die Labels zu generieren (Caption erfolgt mittels Liste ab "A8" bis endlos). Anschliessend kann in der UF ein Label selektriert werden. Der cmd soll die Sub "add" jedoch nur dann ausführen, wenn Label.caption = "Maestro".

Und wie würde dann der Code mit "Rows.Count" aussehen?

Beispiel im Anhang
Angehängte Dateien
Dateityp: xlsm Listbox (Bsp).xlsm (27,0 KB, 2x aufgerufen)
Kinimod1984 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 13:29   #4
EarlFred
MOF Guru
MOF Guru
Standard

Hallo,

Zitat:

Der Instanzaufruf funktioniert zwar, allerdings nicht mit der Bedingung, dass nur in die Zelle geschrieben wird, wenn das selektierte Label die Caption = "Maestro" aufweist.

Diese Info fehlte.

Das Beispiel kann ich mir nicht anschauen, xlsm-Dateien öffne ich nicht.

Dennoch eine allgemeine Überlegung, die sicher nicht schwer umsetzbar ist:
Gib der Klasse noch eine Eigenschaft mit, in der hinterlegt ist, ob das Label das aktive ist. Weise diese Eigenschaft analog der Farbgebung zu und prüfe beim Buttonclick entsprechend, wie schon im Beispiel aus #2 dargestellt.


Code:

ALetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 3 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,023% per 05.12.2017) - eine tolle Geste!

Geändert von EarlFred (13.02.2018 um 13:47 Uhr).
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 14:19   #5
Kinimod1984
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Lieber EarlFred,

Vielen Dank für die rasche Resonanz. Wäre Dir mit einer .xls-Datei gedient? Ich stelle mich vielleicht etwas didaktisch unterbegabt an, jedoch weiss ich nicht, wie ich die Eigenschaft mit Deinem Vorschlag ausstatten kann.

Der angegebene Code werde ich gerne übernehmen. Spielt es dabei einen Tango, in welcher Tabelle sich die Werte befinden? Wäre die Codezeile gleich, auch wenn sich diese bspw. in Tabelle4 befänden?

Sonnige Grüsse aus der Schweiz - Nik
Kinimod1984 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 14:25   #6
Kinimod1984
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Und nein, den Artikel kannte ich bis dato noch nicht und werde folglich etwas sparsamer mit Frames umgehen um Ressourcen zu schonen...
Kinimod1984 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 14:41   #7
EarlFred
MOF Guru
MOF Guru
Standard

Hallo,

Zitat:

Spielt es dabei einen Tango, in welcher Tabelle sich die Werte befinden? Wäre die Codezeile gleich, auch wenn sich diese bspw. in Tabelle4 befänden?

na klar! Dein Code und folglich meine Änderung gehen davon aus, dass die Werte in dem aktiven Blatt stehen. Andernfalls musst Du vollständig referenzieren, innerhalb der Mappe vorzugsweise mit den Codenamen der Tabellen.
also in der Art: Tabelle4.Cells(...)

Ich ging hier davon aus, dass Tabelle1 der Codename der passenden Tabelle ist. Prüfe die Referenzen auf Vollständigkeit und passe ggf. an:

Code:

'Code für Userform:
Option Explicit

Private Sub CommandButton1_Click()
Dim i As Long

For i = LBound(Modul1.cLabel, 1) To UBound(Modul1.cLabel, 1)
  If Modul1.cLabel(i).blnAktiv Then
    If Modul1.cLabel(i).Label.Caption = "Maestro" Then
      Worksheets("Tabelle1").Range("J2").Value = "Hello"
    End If
  End If
Next i
    
End Sub

Private Sub UserForm_Initialize()

Dim LB As Control
Dim LabelCount1 As Integer
Dim i As Long
Dim t As Long
Dim ALetzte As Long

With Tabelle1
  ALetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
End With

t = 0
For i = 8 To ALetzte
    Set LB = UserForm1.Frame1.add("Forms.Label.1", Tabelle1.Range("A" & i).Value, True)
    With LB
        .Top = t
        .Left = 0
        .Width = 130
        .Caption = Range("A" & i).Value
        .ForeColor = vbBlack
        .Font.Size = 12
    End With
    LabelCount1 = LabelCount1 + 1
    ReDim Preserve cLabel(1 To LabelCount1)
    Set cLabel(LabelCount1).Label = LB
t = t + 18
Next i
End Sub
Code:

'Code für die Klasse
Option Explicit

Public WithEvents Label As MSForms.Label

Public blnAktiv As Boolean


Sub Label_Click()
    
    Dim i As Long
    
    For i = LBound(Modul1.cLabel, 1) To UBound(Modul1.cLabel, 1)
      Modul1.cLabel(i).Label.ForeColor = vbBlack
      Modul1.cLabel(i).Label.BackColor = vbWhite
      Modul1.cLabel(i).blnAktiv = False
    Next i
    
    Tabelle1.Range("A1").Value = Label.Caption
    Label.BackColor = vbBlack
    Label.ForeColor = vbWhite
    blnAktiv = True
    
End Sub
Der Code ist immer noch nicht schön, aber für mehr fehlt mir die Zeit.

Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 3 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,023% per 05.12.2017) - eine tolle Geste!
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 14:56   #8
Kinimod1984
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Lieber EarlFred,

Nun ja, was soll ich sagen...

Dein Code macht irgendwie GENAU DAS, was ich seit Wochen suche...und wahrscheinlich hast Du beim Lesen meines Codes vor dem geistigen Auge genau gesehen, was effektiv wo steht und die Applikation abgespielt ohne auch nur eine Excel-Datei zu öffnen - die einzige Dir Unbekannt, liegt in der Anordnung der Steuerelemente...

Wahnsinn und alle Hochachtung! Ganz herzlichen Dank!

Liebe Grüsse - Nik
Kinimod1984 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2018, 16:36   #9
EarlFred
MOF Guru
MOF Guru
Standard

Hallo Nik,

freut mich, wenn ich helfen konnte.

Eins noch auf die Schnelle, was ich beim Hochscrollen sah:
Code:

ReDim Preserve cLabel(1 To LabelCount1)
Du kennst doch von Anfang an die Anzahl der Boxen über 8 To ALetzte. Dann könntest Du das Datenfeld auch einmal zu Beginn auf die benötigte Größe dimensionieren und sparst Dir das stückweise "Redimmen".

Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 3 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,023% per 05.12.2017) - eine tolle Geste!
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:38 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.