Hallöchen an alle Mitglieder
Fange an mich mi VBA zubeschäftigen und bin mir sicher hier wird mir geholfen.
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!
Gruß Hedwig
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.
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?
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.
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
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