Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Friedrichroda /
Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.

Bei Problemen mit der Erreichbarkeit der Foren bitte den Link / Favoriten prüfen und ersetzen. Dazu über die Startseite ins gewünschte Forum wechseln und zu den Favoriten hinzufügen. Excel ist derzeit z.B. unter http://www.clever-excel-forum.de/forum-2.html zu erreichen.


Makro starten mit Button
#1
Hallöchen an alle Mitglieder

Fange an mich mi VBA zubeschäftigen und bin mir sicher hier wird mir geholfen. Blush

Also, seit Wochen plagt mir dieses Makro, habe die und jenes schon probiert. Es funktionieret soweit ganz gut bei jedem Seitenwechsel startet das Macro auch so wie es soll.
Aber ich möchte nicht immer die Seite wechsel damit es aktuell bleibt. Ein Button soll da Abhilfe schaffen. Das Button soll sich in Zelle S4 befinden.

Eine Bitte, schreibt bitte auch wo alle reingeschrieben werden soll. Das untere habe ich im Tabellenblatt.


Private Sub Worksheet_Activate()

af = [b116:b147]
pfad = ThisWorkbook.Path & "\" 'Pfad dieser Datei = Pfad zu den Bilddateien

For i = 1 To 32
bildnr = af(i, 1)
bilddatei = "c" & bildnr & ".gif"

If Dir(pfad & bilddatei) = "" Then
p = ""
Else
p = pfad & bilddatei 'Datei vorhanden, Bilddatei laden
End If

ActiveSheet.OLEObjects("clt" & i).Object.Picture = LoadPicture(p)  

Next 'nächstes Bildobjekt = nächstes 'i'

[c116:c147].Value = [b116:b147].Value

End Sub


Freue mich schon auf eine Lösung! Sleepy

Gruß Hedwig
to top
#2
Hallo Hedwig,

Schreibe den code in ein "normales" Modul und nenne das Makro z.B.

Code:
Sub Aktuelisieren()

af = [b116:b147]
pfad = ThisWorkbook.Path & "\" 'Pfad dieser Datei = Pfad zu den Bilddateien

For i = 1 To 32
bildnr = af(i, 1)
bilddatei = "c" & bildnr & ".gif"

If Dir(pfad & bilddatei) = "" Then
p = ""
Else
p = pfad & bilddatei 'Datei vorhanden, Bilddatei laden
End If

ActiveSheet.OLEObjects("clt" & i).Object.Picture = LoadPicture(p)  

Next 'nächstes Bildobjekt = nächstes 'i'

[c116:c147].Value = [b116:b147].Value

End Sub


Dein bisheriges Makro hälst Du nun ganz kurz:


Code:
Private Sub Worksheet_Activate()

Aktualisieren

End Sub


Wenn Du nun einen Button einfügst, kannst Du diesem das Makro "Aktualisieren" zuweisen.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#3
Hallo André

Ging ja super schnell und ich habe es mal probiert , leider bekomme ich es nicht hin. Sicherlich liegt es an mein VBA Wissen.
So wie auf den Bildern habe ich eingegeben. Ist soweit richtig?
Wenn auf jeder Seite ein Button zu aktualisieren sein würde müsste dann zu jeder Seite immer ein Modul angelegt werden?


Angehängte Dateien Thumbnail(s)
   
to top
#4
Hallo Hedwig,

wenn Du das auf mehreren Seiten mit einem Button tun willst dann kannst Du jedem Button das eine Makro zuweisen.

Wenn Du das Aktualisieren beim Aktivieren einer Seite ausführen willst, dann kannst Du das Makro Private Sub Worksheet_Activate auf dem Modul vom Blatt lassen.
Wenn es beim Aktivieren mehreren Seiten sein soll, kannst Du das Private Sub Worksheet_Activate auf mehreren Seiten einfügen. Alternativ gibt es noch eine Möglichkeit, auch das Activate - Makro nur einmal für die ganze Datei zu programmieren. In DieseArbeitsmappe gibt es dazu
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Da wäre eventuell zu prüfen, ob der code dann auf allen Blättern der Mappe auszuführen ist oder nur auf einigen.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#5
André kann´st Du mir ein Model schreiben mit den Modulen sehe ich nicht durch.

z.B Projektexlorer
1. ANKLICKEN EIN BLATT
2. EINFÜGEN MODUL

dann habe ich schon probleme.

Muss ich für jedes Blatt dann diesen Vorgand wiederholen.

Gruß Horst
to top
#6
Dieses steht im Tabellenblatt.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If [d114] = 0 Then Exit Sub
    'wenn keine Änderung erkannt wird, wird das Makro nicht ausgeführt
    
    af = [b116:b147] 'Indizes der für das AF qualifizierten Teams
    pfad = ThisWorkbook.Path & "\" 'Pfad dieser Datei = Pfad zu den Bilddateien
    
    For i = 1 To 32 'Schleife von 1 bis 32; die 32 Bildobjkete (c1 bis c32)  abarbeiten
        bildnr = af(i, 1) 'Ermittelt die Nummer das anzuzeigenden Wappens
        bilddatei = "c" & bildnr & ".gif" 'Name der Grafikdatei
        
        If Dir(pfad & bilddatei) = "" Then 'Überprüfen, ob die Datei vorhanden ist
            p = "" 'Datei kann nicht gefunden werden, kein Bild laden
        Else
            p = pfad & bilddatei 'Datei vorhanden, Bilddatei laden
        End If
        
        'die Objekte heißen c1  bis c32; entsprechend muss im Makro auch afx für den Namen genutzt werden
        'das 'i' als Schleifenvariable durchläuft, während das Makro abgearbeitet wird, die Werte von 1 bis 32
        'es wird also zunächst das Objekt "c" & 1 = c1, dann "c" & 2 = c3  usw. abgearbeitet
        'insgesamt wird der folgende Befehl damit 32 mal ausgeführt, wobei  i  die Werte von  1 bis 32 durchläuft
        ' den einzelnen Objelkten c1  bis c32 wird dabei immer das durch den Bereich b116:b147 vorgegebene Wappen zugeordnet
        
        
        ActiveSheet.OLEObjects("c" & i).Object.Picture = LoadPicture(p)  'Grafik dem Bildobjekt zuweisen
        
    Next 'nächstes Bildobjekt = nächstes 'i'
    
    'aktuellen Stand (Indizes) in den Zellen c116:c147 speichern
    'b116:b147 ist der aktuelle Stand, der in c116:c147 für einen spätern Vergleich als TEXT gespeichert wird
    [c116:c147].Value = [b116:b147].Value
    'Die Zelle F20  wird durch diesen Eintrag automatisch zu 0, weil nun der aktuelle (b107:b135) und der zuletzt gespecherte Stand (c107:c135) identisch sind
    'Wenn Änderungen bei den Gruppenergebnissen die für das AF qualifizierten Teams ändern, ändert sich auch Zelle d114
    'das Makro wird dann beim Aufruf des Blattes wieder ausgeführt und die Wappen angepasst

Und das in Modul1.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("J8:j60")) Is Nothing Then
     MsgBox "Im Bereich J8:j60 wurde eine Zelle geändert!"
  End If
End Sub
to top
#7
Hallo Hedwig,

vielleicht hilft Dir diese Seiten weiter

Wie und wo fügt man ein Makro bzw. Code ein
Module und VBAProject

Dein Worksheet_Change-Ereignis gehört in ein Tabellenmodul.
Gruß Stefan
Win 7 / Office 2007
to top
#8
(10.03.2015, 18:50)Steffl schrieb: Hallo Hedwig,

vielleicht hilft Dir diese Seiten weiter

Wie und wo fügt man ein Makro bzw. Code ein
Module und VBAProject

Dein Worksheet_Change-Ereignis gehört in ein Tabellenmodul.

Habe die Lösung gefunden, danke.
to top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste