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:
927
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

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
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