Thema Datum  Von Nutzer Rating
Antwort
Rot Bild dynamisch in Image1 einfügen (UserForm)
20.12.2022 11:24:33 Markus
Solved
20.12.2022 13:23:08 Gast11248
Solved
20.12.2022 13:49:13 Gast42272
Solved
20.12.2022 18:58:19 Flotter Feger
NotSolved

Ansicht des Beitrags:
Von:
Markus
Datum:
20.12.2022 11:24:33
Views:
111
Rating: Antwort:
 Nein
Thema:
Bild dynamisch in Image1 einfügen (UserForm)

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


 


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
Rot Bild dynamisch in Image1 einfügen (UserForm)
20.12.2022 11:24:33 Markus
Solved
20.12.2022 13:23:08 Gast11248
Solved
20.12.2022 13:49:13 Gast42272
Solved
20.12.2022 18:58:19 Flotter Feger
NotSolved