ich habe ein Excel Formular erstellt, und gebe in Zelle D28, D52, D76 und D100 einen Bildernamen ein, das bild wird dann automatisch eingefügt. Beim Klich auf die zelle D28… etc möchte ich aber nicht den namen eingeben, sondern der Explorer/dateimanager sollte aufgerufen werden, damit ich den namen direkt anklicken kann.
Hier nun mein Code:
Dim SNZelle As String
Dim StOrdner As String ’ Variable Ordner Bildablage
Dim StBild As String ’ Variable Bildname
Dim InI As Integer ’ Variable Schleifenzähler
Dim RaBereich As Range ’ Variable Bereich der Gültigkeit
Dim RaZelle As Range ’ Variable bearbeitete Zelle
Dim LoBreite As Long ’ Variable Bildbreite
Dim LoHoehe As Long ’ Variable Bildhöhe
SNZelle = „“
’ Ordner Bildablage
StOrdner = „d:\Bilder“ & Range(„D5“) & SNZelle ’ Verzeichnis "D:\Bilder+„Schadensnummer“ aus Zelle D5+ „“
Set RaBereich = Range(„D28,D52,D76,D100“) ’ Bereich der Wirksamkeit
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then ’ falls nicht gefunden wird sub verlassen
For Each RaZelle In RaBereich ’ Schleife über alle veränderten Zellen
Application.EnableEvents = False ’ Reaktion auf Zellveränderung abschalten
RaZelle.Offset(0, 1) = „“ ’ Inhalt der Zelle neben Bildnamen löschen
Application.EnableEvents = True ’ Reaktion auf Zellveränderung einschalten
’ Bildname erstellen
StBild = "Bild " & RaZelle.Address(False, False)
’ altes Bild löschen von jinx
For InI = ActiveSheet.Shapes.Count To 1 Step -1
If ActiveSheet.Shapes(InI).Name = StBild Then
ActiveSheet.Shapes(InI).Delete
Exit For
End If
Next
’ ************
If RaZelle.Value „“ Then ’ eine Eingabe ist vorhanden
’ Bildname einschl. Ordner erstellen
StBild = StOrdner & Format(RaZelle.Value, „“) & „.jpg“
If Dir(StBild) = „“ Then ’ Prüfung ob Bild vorhanden
Application.EnableEvents = False ’ Reaktion auf Zellveränderung abschalten
’ Bild nicht vorhanden
Target.Offset(0, 4) = „Kein Bild vorhanden!“
Application.EnableEvents = True ’ Reaktion auf Zellverändeung einschalten
Else ’ Bild vorhanden
’ Bildgröße und Bild bei Position einfügen
Select Case Target.Address(False, False)
Case „D28“
LoBreite = 635
LoHoehe = 395
’ einfügen ohne select
’ Ausdruck.AddPicture(FileName, Verknüpfung,in Mappe speichern,
’ Pos. Links, Pos. Oben, Breite, Höhe)
’ von Jürgen Nagel
’ erstes Offset Pos. Links 0 Zeilen und eine Spalte nach rechts
’ zweites Offset Pos. Oben 0 Zeilen tiefer und 0 Spalten nach rechts
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
’ ********
Case „D52“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
Case „D76“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
Case „D100“
LoBreite = 635
LoHoehe = 395
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(1, 4).Left - LoBreite, _
RaZelle.Offset(1, 4).Top - LoHoehe, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
End Select
End If
End If
Next RaZelle
End If
Set RaBereich = Nothing ’ Variable leeren
End Sub