Anzeige
Archiv - Navigation
1468to1472
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro für eine Klick und Enter Schlaufe

Makro für eine Klick und Enter Schlaufe
15.01.2016 14:12:46
bykov
Guten Tag
Ich habe ein Excel Sheet mit 4 Tabellenblättern. In diesen Tabellen sind ca. 10 - 19 Bilder die ich mittels Image1 - Image19 und draufklicken aus einem Fotoordner hole.
Ebenfalls wird durch ein Makro der Name des Bildes direkt ins Suchfeld geschrieben.
Konkret sieht das so aus
Private Sub Image1_Click()
Dim fd As FileDialog
Dim Pfad As String
Dim Datei As String
Pfad = "Pfad\"
If ActiveSheet.Range("S19") = "FRE_" Then
Datei = "leer"
Else
Datei = ActiveSheet.Range("S19")
End If
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.InitialFileName = Pfad & Datei
.Filters.Add "Images", "*.bmp", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Me.Image1.Picture = LoadPicture(vrtSelectedItem)
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
End Sub

Die Fotos ändern immer wieder und die Tabellen müssen aktualisiert werden.
Nun möchte ich eine Makro das mir die Befehle anklicken des Images und Befehl Enter bei allen auslöst.
Ist das möglich?
Zu meinen Excel-Kenntnissen, ich habe mir fast alles selber beigebracht und nie einen Kurs besucht. Wenn ich nicht weiterkomme frage ich oder suche im Web nach einer Lösung

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro für eine Klick und Enter Schlaufe
15.01.2016 15:05:21
fcs
Hallo bykow,
Man kann in einer Schleife zum Beispiel alle Bilddateien für im aktiven Tabellenblatt aus den Zellen einlesen und den Images zuweisen.
Wenn die Dateinamen in einem Zellbereich untereinander oder nebeneinader stehen, dann kann man den Dateinamen auch anders auslesen als über Case-Anweisungen.
Gruß
Franz
Sub LoadAllPictures()
Dim objOleObject As OLEObject
Dim intP As Integer
Dim Pfad As String
Dim Datei As String
Pfad = "Pfad\"
Pfad = "D:\Picture\"
For intP = 1 To 19
'Zellen mit den Bild-Dateinamen für einzelnen Images festlegen
Datei = ""
Select Case intP
Case 1
If ActiveSheet.Range("S19")  "FRE_" Then Datei = ActiveSheet.Range("S19")
Case 2
If ActiveSheet.Range("S20")  "FRE_" Then Datei = ActiveSheet.Range("S20")
'u.s.w bis
Case 19
Case Else
Datei = ""
End Select
If Datei  "" Then
If Dir(Pfad & Datei & ".bmp")  "" Then
Set objOleObject = ActiveSheet.OLEObjects("Image" & intP)
objOleObject.Object.Picture = LoadPicture(Pfad & Datei & ".bmp")
End If
End If
Next
End Sub

Anzeige
AW: Makro für eine Klick und Enter Schlaufe
18.01.2016 15:11:09
bykov
Hallo Franz
Funktioniert super. Herzlichen Dank.
Gruss
bykov

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige