Habe untestehende Code zum bilder einfügen von Hajo's Seite.
meine Frage:
- wie kan ich Bilder einfugen wobei die Bildernamen in ein andere tabelle liegen (Tabelle1) bereich A8:A100
- bildname komen in Zelle Set RaBereich = Range("A10,C10,E10,G10") Tabelle (bilder) dies wird noch erweitert.
- WICHTIG bildnamen werden uber Formel =Tabelle1!A10 & "" eingelesen dass Problem dabei bilder werden nicht eingelesen nur wenn ich direkt ein Wert im Zellen Eingeben wirden Bilder eingelesen.
Wie kann man dass lösen?
anbei Code Option Explicit ' Variablendefinition erforderlich
' Konstante für Ablagepfad Bilder
Const StPfad As String = "c:\test\"
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies *
'* 01.01.09 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/
Dim StBild As String ' Variable für Bildname
Dim InI As Integer ' Schleifenvariable
Dim RaBereich As Range ' Bereich der _
Wirksamtkeit
Dim RaZelle As Range ' Zelle die in der _
Schleife bearbeitet wird
' Bereich der Wirksamkeit
If Target.Value = ("A10,C10,E10,G10") Then Exit Sub
Set RaBereich = Range("A10,C10,E10,G10")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 , C21: _
AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53: _
AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 , _
C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115: _
_
_
AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 , _
_
_
C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 , _
C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 , _
C195:AG195 , C197:AG197"))
Set RaBereich = Intersect(RaBereich, Range(Target.Address)) ' nur die Zellen Prüfen _
_
_
die im überwachten Bereich liegen
If Not RaBereich Is Nothing Then 'falls nicht gefunden _
_
_
wird sub verlassen
For Each RaZelle In RaBereich ' Schleife über alle _
veränderten Zellen im überwachten Bereich
Application.EnableEvents = False ' Reaktion auf Eingabe _
_
_
abschalten
' Text "kein Bild" löschen
RaZelle.Offset(-1, 0) = ""
Application.EnableEvents = True ' Reaktion auf Eingabe _
_
_
einschalten
StBild = "Bild " & RaZelle.Address(False, False) ' Bildname erstellen
' 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 ' es wurde ein _
Dateiname eingegeben
' Bildname
'StBild = StPfad & "D" & Format(RaZelle.Value, "00000") & ".jpg"
StBild = StPfad & "" & Format(RaZelle.Value) & ".jpg"
If Dir(StBild) = "" Then ' Prüfen ob Datei _
vorhanden
Application.EnableEvents = False ' Reaktion auf Eingabe _
_
_
abschalten
Target.Offset(-1, 0) = "kein Bild"
Application.EnableEvents = True ' Reaktion auf Eingabe _
_
_
einschhalten
Else
' einfügen ohne select von Bert Körn
' Ausdruck.AddPicture(FileName, Verknüpfung, in Mappe speichern,
' Pos. Links, Pos. Oben, Breite, Höhe)
' von Klausimausi64 Bildname
' erstes Offset Pos. Links 0 Zeilen und eine Spalte nach rechts
' zweites Offset Pos. Oben 0 Zeilen tiefer und 0 Spalten nach rechts
With ActiveSheet.Shapes.AddPicture(StBild, True, True, RaZelle.Offset(0, 0). _
_
_
Left, _
RaZelle.Offset(-1, 0).Top, 140, 140)
sngHoehe = .Height 'Bildhöhe an Variable übergeben _
Hinweis von Uwe (:o)
.OnAction = "Bild_BeiKlick" ' Makro im Modul BeiKlick
.Name = "Bild " & RaZelle.Address(False, False) ' Bildname festlegen
End With
End If
End If
Next RaZelle
End If
Set RaBereich = Nothing ' Variable leeren
End Sub
Grüsse
Karel