|
Hallo liebe VBA-Community;
ich habe eine Turnierplaner-Excel und möchte diese noch etwas aufpimpen und hoffe ihr könnt mir dabei weiterhelfen. Leider kenne ich mich mit VBA zu schlecht aus.
Im Arbeitsblatt "Gruppenspiele" erscheint UserForm1 sobald ich das Spielergebnis von "Heim" vs "Gast" eintragen möchte. "Heim" und "Gast" sind jeweils Label1 und Label2. Die Teamnamen bei Heim und Gast werden per Code aus Tabelle5 entnommen.
Nun soll jeweils ein Bild im Image1 & Image2 von den Team's in der UserForm erscheinen. Sprich, wenn "Team1" (Label1) gegen "Team12" (Label2) spielt, soll auch dynamisch das Bild ("Team1.jpg") und "Team12.jpg" erscheinen.
Pfad und Dateiname der Bilder ("C:\Users\Markus\Pictures\Bilder\Team1.jpg")
Über Eure Hilfe würde ich mich sehr freuen
Gruß Markus
Private Sub CommandButton2_Click()
End
End Sub
Private Sub UserForm_Initialize()
Label1.Caption = Heim
Label2.Caption = Gast
Label4.Caption = Titel
'Heim_Gewinnsatz = Tabelle3.Cells(SpielZeile, 9).Value
'Gast_Gewinnsatz = Tabelle3.Cells(SpielZeile, 11).Value
Heim_Gewinnsatz = Heim_Anz_Gewinnsatz
Gast_Gewinnsatz = Gast_Anz_Gewinnsatz
'Spielkorrektur?
'prüfe ob Heim oder Gast bereits mehr als 0 eingetragen hat, also ob bereits ein Ergebnis erfasst wurde..
If Heim_Gewinnsatz > 0 Or Gast_Gewinnsatz > 0 Then
'wenn ja, dann handelt es sich um eine Spielkorrektur
Spielkorrektur = True
Heim_Gewinnsatz_vorheriger_Wert = Heim_Gewinnsatz 'altes Ergebnis merken
Gast_Gewinnsatz_vorheriger_Wert = Gast_Gewinnsatz 'altes Ergebnis merken
Else
'wenn nein, dann ist es ein erstmaliger Ergebniseintrag
Spielkorrektur = False
End If
'Bild dynamisch einfügen nach Teamname
Image1.Picture = LoadPicture("C:\Users\Markus\Pictures\Bilder\Bild1.jpg")
'Bildgröße anpassen
Image1.PictureSizeMode = fmPictureSizeModeZoom
End Sub
Private Sub Heim_Gewinnsatz_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57:
If InStr(1, Heim_Gewinnsatz, ",") > 0 Then
KeyAscii = IIf(InStr(1, Heim_Gewinnsatz, ",") > Len(Heim_Gewinnsatz) - 2, KeyAscii, 0)
End If
Case 44, 46: KeyAscii = IIf(InStr(1, Heim_Gewinnsatz, ",") = 0, 44, 0)
Case 45: KeyAscii = IIf(Len(Heim_Gewinnsatz), 0, 45)
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub Gast_Gewinnsatz_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57:
If InStr(1, Gast_Gewinnsatz, ",") > 0 Then
KeyAscii = IIf(InStr(1, Gast_Gewinnsatz, ",") > Len(Gast_Gewinnsatz) - 2, KeyAscii, 0)
End If
Case 44, 46: KeyAscii = IIf(InStr(1, Gast_Gewinnsatz, ",") = 0, 44, 0)
Case 45: KeyAscii = IIf(Len(Gast_Gewinnsatz), 0, 45)
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub CommandButton1_Click()
Dim Team_Gast As String
Dim Team_Heim As String
Dim Anz_Gewinnsatze As Integer
Dim Gast_finden As Range
Dim Heim_finden As Range
Anz_Gewinnsatze = Tabelle13.Range("C7").Value 'benötigte Gewinnsätze für Spielgewinn
Heim_Anz_Gewinnsatz = Heim_Gewinnsatz.Value
Gast_Anz_Gewinnsatz = Gast_Gewinnsatz.Value
If Heim_Anz_Gewinnsatz = Gast_Anz_Gewinnsatz Then
MsgBox "Es darf kein Unentschieden eingetragen werden!", vbExclamation + vbOKOnly, "Fehler"
Exit Sub
End If
If Heim_Anz_Gewinnsatz > Anz_Gewinnsatze Or Gast_Anz_Gewinnsatz > Anz_Gewinnsatze Then
MsgBox "Die maximal mögliche Anzahl Gewinnsätze beträgt " & Anz_Gewinnsatze & "." & vbNewLine & "Bitte korrigieren oder ggfs. anpassen in Tabelle Grunddaten.", vbCritical + vbOKOnly, "Achtung"
Exit Sub
End If
'--------------------------------------------------------------------
'hier nur Ergebnisse in 8erDKO, 16erDKO, 32erDKO, 8er, 16er, 32er Finale eintragen ohne weiteres
If Finale8 = True Then
'nur Spielergebnis eintragen
Tabelle4.Cells(SpielZeile, 16).Value = Heim_Anz_Gewinnsatz
Tabelle4.Cells(SpielZeile, 18).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
If Finale16 = True Then
'nur Spielergebnis eintragen
Tabelle9.Cells(SpielZeile, 16).Value = Heim_Anz_Gewinnsatz
Tabelle9.Cells(SpielZeile, 18).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
If Finale32 = True Then
'nur Spielergebnis eintragen
Tabelle10.Cells(SpielZeile, 17).Value = Heim_Anz_Gewinnsatz
Tabelle10.Cells(SpielZeile, 19).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
If Finale8N = True Then
'nur Spielergebnis eintragen
Tabelle6.Cells(SpielZeile, 16).Value = Heim_Anz_Gewinnsatz
Tabelle6.Cells(SpielZeile, 18).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
If Finale16N = True Then
'nur Spielergebnis eintragen
Tabelle14.Cells(SpielZeile, 16).Value = Heim_Anz_Gewinnsatz
Tabelle14.Cells(SpielZeile, 18).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
If Finale32N = True Then
'nur Spielergebnis eintragen
Tabelle15.Cells(SpielZeile, 17).Value = Heim_Anz_Gewinnsatz
Tabelle15.Cells(SpielZeile, 19).Value = Gast_Anz_Gewinnsatz
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Unload Userform1
Exit Sub
End If
'--------------------------------------------------------------------
Application.EnableEvents = False
Application.ScreenUpdating = False
'Teams benennen
Team_Heim = Label1.Caption
Team_Gast = Label2.Caption
With Tabelle5.Range("M:M")
'suche Teams in Tabelle5 "Rechnen"
Set Heim_finden = .Find(Team_Heim, LookIn:=xlValues, LookAt:=xlWhole) 'findet Heim in Tabelle5, wird für Zeile benötigt in die Ergebnis eingetragen wird
Set Gast_finden = .Find(Team_Gast, LookIn:=xlValues, LookAt:=xlWhole) 'findet Gast in Tabelle5, wird für Zeile benötigt in die Ergebnis eingetragen wird
'Fehlerprüfung falls es diese Teams nicht geben sollte..
If Heim_finden Is Nothing Then GoTo fehler
If Gast_finden Is Nothing Then GoTo fehler
'--------------------------------------------------------------------
'wenn Spielkorrektur = true, dann zuerst das alte Ergebnis von beiden Teams zurücknehmen aus der Aufzeichnung
If Spielkorrektur = True Then
With Tabelle5
'Variablenwert, nur zum prüfen hier nochmal anzusehen
Heim_Gewinnsatz_vorheriger_Wert = Heim_Gewinnsatz_vorheriger_Wert
Gast_Gewinnsatz_vorheriger_Wert = Gast_Gewinnsatz_vorheriger_Wert
'Spalte O - Spielanzahl -1 /Spielanzahl wieder abziehen
.Cells(Heim_finden.Row, 15).Value = .Cells(Heim_finden.Row, 15).Value - 1
.Cells(Gast_finden.Row, 15).Value = .Cells(Gast_finden.Row, 15).Value - 1
'Spalte P - Spielsieg -1 /eventuellen Spielsieg wieder abziehen
If Heim_Gewinnsatz_vorheriger_Wert > Gast_Gewinnsatz_vorheriger_Wert Then
'wenn Heim gewonnen hatte..
.Cells(Heim_finden.Row, 16).Value = .Cells(Heim_finden.Row, 16).Value - 1
Else 'wenn Gast gewonnen hatte..
.Cells(Gast_finden.Row, 16).Value = .Cells(Gast_finden.Row, 16).Value - 1
End If
'Spalte Q - Gewinnsätze zurücknehmen / abziehen
.Cells(Heim_finden.Row, 17).Value = .Cells(Heim_finden.Row, 17).Value - Heim_Gewinnsatz_vorheriger_Wert
.Cells(Gast_finden.Row, 17).Value = .Cells(Gast_finden.Row, 17).Value - Gast_Gewinnsatz_vorheriger_Wert
End With
'variable wieder zurücksetzen
Spielkorrektur = False
End If
'--------------------------------------------------------------------
'ab hier erfolgt Erfassung vom Ergebnis..
'--- Team Heim eintragen ---------------------------------------------------
With Tabelle5
'Spalte O - Spiel eintragen / vorhandenen Eintrag um 1 erhöhen
If .Cells(Heim_finden.Row, 15).Value = "" Then
.Cells(Heim_finden.Row, 15).Value = 1
Else
.Cells(Heim_finden.Row, 15).Value = .Cells(Heim_finden.Row, 15).Value + 1
End If
'Spalte P - Spielsieg eintragen
If Heim_Anz_Gewinnsatz > Gast_Anz_Gewinnsatz Then
If Tabelle5.Cells(Heim_finden.Row, 16).Value = "" Then
Tabelle5.Cells(Heim_finden.Row, 16).Value = 1
Else
Tabelle5.Cells(Heim_finden.Row, 16).Value = Tabelle5.Cells(Heim_finden.Row, 16).Value + 1
End If
Else 'wenn Heim < Gast dann..
If Tabelle5.Cells(Heim_finden.Row, 16).Value = "" Then
Tabelle5.Cells(Heim_finden.Row, 16).Value = 0 'wenn noch kein Eintrag dann 0, damit ein sortierbarer Wert entsteht = mindestens 0 als eintragen
End If
End If
'Spalte Q - Gewinnsätze eintragen/ vorhandenen Eintrag erhöhen
If .Cells(Heim_finden.Row, 17).Value = "" Then
.Cells(Heim_finden.Row, 17).Value = Heim_Anz_Gewinnsatz
Else
.Cells(Heim_finden.Row, 17).Value = .Cells(Heim_finden.Row, 17).Value + Heim_Anz_Gewinnsatz
End If
End With
'--- Team Gast eintragen ---------------------------------------------------
With Tabelle5
'Spalte O - Spiel eintragen / vorhandenen Eintrag um 1 erhöhen
If .Cells(Gast_finden.Row, 15).Value = "" Then
.Cells(Gast_finden.Row, 15).Value = 1
Else
.Cells(Gast_finden.Row, 15).Value = .Cells(Gast_finden.Row, 15).Value + 1
End If
'Spalte P - Spielsieg eintragen
If Gast_Anz_Gewinnsatz > Heim_Anz_Gewinnsatz Then
If Tabelle5.Cells(Gast_finden.Row, 16).Value = "" Then
Tabelle5.Cells(Gast_finden.Row, 16).Value = 1
Else
Tabelle5.Cells(Gast_finden.Row, 16).Value = Tabelle5.Cells(Gast_finden.Row, 16).Value + 1
End If
Else 'wenn Gast < Heim dann..
If Tabelle5.Cells(Gast_finden.Row, 16).Value = "" Then
Tabelle5.Cells(Gast_finden.Row, 16).Value = 0 'wenn noch kein Eintrag dann 0, damit ein sortierbarer Wert entsteht = mindestens 0 als eintragen
End If
End If
'Spalte Q - Gewinnsätze eintragen/ vorhandenen Eintrag erhöhen
If .Cells(Gast_finden.Row, 17).Value = "" Then
.Cells(Gast_finden.Row, 17).Value = Gast_Anz_Gewinnsatz
Else
.Cells(Gast_finden.Row, 17).Value = .Cells(Gast_finden.Row, 17).Value + Gast_Anz_Gewinnsatz
End If
End With
End With
'--- Ende Ergebnisse der Teams eintragen ---------------------------------------------------
'Spielergebnis übernehmen in Gruppenspielübersicht
Tabelle3.Cells(SpielZeile, 9).Value = Heim_Anz_Gewinnsatz
Tabelle3.Cells(SpielZeile, 11).Value = Gast_Anz_Gewinnsatz
Set Heim_finden = Nothing
Set Gast_finden = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Unload Userform1
Call sortieren
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
Exit Sub
fehler:
Application.EnableEvents = True
Application.ScreenUpdating = True
Gruppenspiele = False
Finale8 = False
Finale16 = False
Finale32 = False
Finale8N = False
Finale16N = False
Finale32N = False
Spielkorrektur = False
End Sub
|