Grafik in UF einfügen

hallo Leute,
https://www.herber.de/bbs/user/86915.xlsm
die Beispieldatei wurde auf das notwendigste bereinigt; Tabellenblatt1 enthält 12 Grafiken mit Tierkreiszeichen und ihren deutschen Namen; jeweils eines dieser Zeichen soll in die mitgelieferte UF eingefügt werden sobald das entsprechende Kriterium erfüllt ist.
Zur Zeit sind diese Symbole in einem separaten Verzeichnis als 12 einzelne Dateien (mit englischen Namen) abgelegt.
Der zum Einfügen einer bestimmten Grafik in die UF erforderliche Programmcode ist im Makro als Select..Case-Anweisung abgespeichert.
Künftig will ich die Grafiksymbole auf einem Tabellenblatt der gleichen Datei abspeichern und nicht mehr in einem separaten Verzeichnis.
Meine Frage lautet: kann mir jemand mitteilen wie der Programmcode lauten muss damit im Rahmen der Select..Case-Anweisung eine der 12 Grafiksymbole vom Tabellenblatt1 in die UF eingefügt wird?
mfg
reiner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DildInUserForm() Dim strPfad As String Dim chDiagramm As ChartObject Dim shBild As Picture Application.ScreenUpdating = False Set shBild = ActiveSheet.Pictures(1) shBild.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set chDiagramm = ActiveSheet.ChartObjects.Add(0, 0, shBild.Width, shBild.Height) With chDiagramm.Chart .Paste .Export Filename:="D:\Test\Bild.jpg", FilterName:="JPG" ' andere Grafikformate sind mö _ glich End With If Not Me.Image1.Picture Is Nothing Then Image1.Picture = Nothing End If UserForm1.Image1.Picture = LoadPicture("D:\Test\Bild.jpg") DoEvents chDiagramm.Delete Kill "D:\Test\Bild.jpg" UserForm1.Show Set chDiagramm = Nothing Set shBild = Nothing Application.ScreenUpdating = True End Sub

Hallo Reiner,
dein Makro zur Berechnung des Tierkreiszeichnens muss dann etwa wie folgt aussehen.
Die Namen der Images muss du anpassen. Sie sollten aber fortlaufend von 1 bis 12 nummeriert sein.
Gruß
Franz

Private Sub Tierkreiszeichenberechnung()
Dim intI As Integer
'alle Bilder ausblenden
For intI = 1 To 12
Me.Controls("ImageTKZ" & intI).Visible = False
Next
'Bild zum Tag einblenden
Select Case TageSeitNeujahr
Case 21 To 50
Tierkreiszeichen = "Wassermann; 21.Januar bis 19.Februar"
ImageTKZ1.Visible = True
Case 51 To 80
Tierkreiszeichen = "Fische; 20.Februar bis 20.März"
ImageTKZ2.Visible = True
Case 81 To 111
Tierkreiszeichen = "Widder; 21.März bis 20.April"
ImageTKZ3.Visible = True
Case 112 To 142
Tierkreiszeichen = "Stier; 21.April bis 21.Mai"
ImageTKZ4.Visible = True
Case 143 To 173
Tierkreiszeichen = "Zwillinge; 22.Mai bis 21.Juni"
ImageTKZ5.Visible = True
Case 174 To 204
Tierkreiszeichen = "Krebs; 22.Juni bis 22.Juli"
ImageTKZ6.Visible = True
Case 205 To 236
Tierkreiszeichen = "Löwe; 23. Juli bis 23.August"
ImageTKZ7.Visible = True
Case 237 To 267
Tierkreiszeichen = "Jungfrau; 24.August bis 23.September"
ImageTKZ8.Visible = True
Case 268 To 297
Tierkreiszeichen = "Waage; 24.September bis 23.Oktober "
ImageTKZ9.Visible = True
Case 298 To 327
Tierkreiszeichen = "Skorpion; 24.Oktober bis 22.November"
ImageTKZ10.Visible = True
Case 328 To 356
Tierkreiszeichen = "Schütze; 23.November bis 21.Dezember"
ImageTKZ11.Visible = True
Case 1 To 20, 357 To 366
Tierkreiszeichen = "Steinbock; 22.Dezember bis 20.Januar"
ImageTKZ12.Visible = True
End Select
End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Grafik in UF einfügen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread