Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

zellgroße an bildgröße anpassen

zellgroße an bildgröße anpassen
Karel
Hallo Forum,
ist es möglich das wenn ein bild in Spalte A eigefügt wird diese Zelle sich automatisch anpasst an der vorgebenen bildgröße " With ActiveSheet.Shapes.AddPicture(StBild, True, True, RaZelle.Offset(0, -1).Left, _
RaZelle.Offset(0, -1).Top, 140, 140)" ?
Wenn kein bild dann zelle wieder auf normale größe zurücksetzen.
In spalte B sind immer wieder unterschiedliche bildnamen erhalten.
Option Explicit ' Variablendefinition erforderlich
Const StPfad As String = "c:\picture\" 'Konstante für Ablagepfad Bilder
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'* H. Ziplies                                     *
'* 24.11.2007                                     *
'* erstellt von HajoZiplies@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.Cells.Count > 1 Then Exit Sub
If Target.Value = ("B4:B100") Then Exit Sub
Set RaBereich = Range("B4:B100")
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(0, -1) = ""
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"
'StBild = StPfad & "" & Format(RaZelle.Value) & ""
If Dir(StBild) = "" Then                                ' Prüfen ob Datei  _
vorhanden
Application.EnableEvents = False                    ' Reaktion auf Eingabe  _
abschalten
Target.Offset(0, -1) = "SORRY NO PICTURE"
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, -1) _
.Left, _
RaZelle.Offset(0, -1).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

Grusse
Karel
AW: zellgroße an bildgröße anpassen
22.07.2010 12:27:42
Hajo_Zi
Hallo Karel,
nach Bild einfügen
Razelle.Rows.RowHeight = 140
und
Else
Razelle.Rows.RowHeight = 14.75
End if
Next Razelle
Vermute ich mal ohne Testung

AW: zellgroße an bildgröße anpassen
22.07.2010 13:13:48
Karel
Hallo Hajo,
Danke für antworten
habe Code eingefügt "Fett dargestellt" bekommen einen fehlermeldung bin mir nicht sicher ob ich es am richtige stelle gemacht habe, noch nicht genügend erfahrung.
' 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, -1).Left, _
RaZelle.Offset(0, -1).Top, 140, 140)
RaZelle.Rows.RowHeight = 140
Else
RaZelle.Rows.RowHeight = 14.75
End If
Next RaZelle

End With
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
Grusse
Karel
Anzeige
AW: zellgroße an bildgröße anpassen
22.07.2010 13:32:23
Karel
vergessen of frage offnen zu setzen
Grüße
KAREL
AW: zellgroße an bildgröße anpassen
22.07.2010 16:17:38
Hajo_Zi
Hallo Karel,
da hätte ich es auch hingeschrieben. Ich sehe leider nicht welche Datei Du von mir benutzt hast. Darum tue ich mich mit dem testen ein wenig schwer.
Gruß Hajo
AW: zellgroße an bildgröße anpassen
22.07.2010 20:53:13
Karel
Hallo Hajo,
So bin jetzt zuhause es ist deine Datei: Bild einfügen02
Grusse
Karel
AW: zellgroße an bildgröße anpassen
22.07.2010 21:05:03
Hajo_Zi
Hallo Karel,
ich habe es jetzt am Original getestet mit Erfolg.
Option Explicit                                                         ' Variablendefinition  _
erforderlich
'   Konstante für Ablagepfad Bilder
Const StPfad As String = "M:\Bilder\0001-1000\"
Private Sub Worksheet_Change(ByVal Target As Range)
'* H. Ziplies                                     *
'* 01.01.09                                       *
'* erstellt von HajoZiplies@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
Set RaBereich = Range("A10,A20,A30,A40")
'   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(0, 1) = ""
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"
If Dir(StBild) = "" Then                                ' Prüfen ob Datei  _
vorhanden
Application.EnableEvents = False                    ' Reaktion auf Eingabe  _
abschalten
Target.Offset(0, 1) = "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, 100, 100)
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
RaZelle.Offset(1, 0).Rows.RowHeight = 100
Else
RaZelle.Offset(1, 0).Rows.RowHeight = 14.75
End If
Next RaZelle
End If
Set RaBereich = Nothing                                             ' Variable leeren
End Sub
Gruß Hajo
Anzeige
AW: zellgroße an bildgröße anpassen
23.07.2010 10:37:29
Karel
Hallo Hajo,
einfach Cool
Viele dank und grüsse
Karel
AW: zellgroße an bildgröße anpassen
23.07.2010 11:45:24
Karel
Hallo Hajo,
Ich greife nochmal gleiche Tread auf.
Habe noch einer frage.
Option Explicit ' Variablendefinition erforderlich
' Konstante für Ablagepfad Bilder
Const StPfad As String = "M:\Bilder\0001-1000\"
Kann man diese Konstante auch variabel machen mit angaben der Dateinamen in Zelle b1
Ich will deine Code im mehrere Tabelle einfügen die auf unterschiedliche Dateien sollte zu
greifen.
Grusse
Karel
AW: zellgroße an bildgröße anpassen
23.07.2010 11:51:58
Hajo_Zi
Hallo Karel,
lösche die Zeile und im Change als erstes
Dim StPfad As String
StPfad = Range("B1")
Gruß Hajo
Anzeige
AW: zellgroße an bildgröße anpassen
23.07.2010 13:13:12
Karel
Klappt
Danke und Grüsse
Kareö

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige