Herbers Excel-Forum - das Archiv

Bild einfügen

Bild

Betrifft: Bild einfügen
von: Brit

Geschrieben am: 15.04.2005 12:39:51
Hallo!
Ich möchte mit dem nachfolgenden Code mehere Bilder innerhalb einer Schleife einfügen!
Das klappt auch schon ganz gut!
Nun soll jeweils das eingefügte Bild in die Mitte der Zelle ausgerichtet werden.
Da genau hackt es : Es passiert nichts!
Das Bild ist immer noch an der linken Seite der Zelle!
Kann mir vielleicht jemand helfen?
Danke
Brit

Sub Bild_einfügen()
Application.ScreenUpdating = False
Dim code
Range("A:A").Activate
On Error Resume Next
Dim Zelle
For Each Zelle In Range("A:A")
code = ActiveCell.Value
code = code & ".eps"
code = LCase(code)
ActiveCell.Offset(0, 2).Activate
pfad = ThisWorkbook.Path & "\" & code
ActiveSheet.Pictures.Insert (pfad)
dHeight = ActiveSheet.Pictures.Height
ActiveCell.Rows.RowHeight = dHeight
ActiveSheet.Pictures.Left = ActiveSheet.Pictures.Left + (ActiveCell.Width / 2) - (ActiveSheet.Pictures.Width / 2)
If ActiveCell.Offset(1, -2) = "" Then Exit For
ActiveCell.Offset(1, -2).Activate
Next Zelle
Application.ScreenUpdating = True
End Sub

Bild

Betrifft: AW: Bild einfügen
von: Micha
Geschrieben am: 15.04.2005 13:53:10
hallo,
das ist nur ein kleiner Denkfehler
schreibe
ActiveSheet.Pictures.Left = ActiveSheet.Pictures.Left + (ActiveCell.Width - ActiveSheet.Pictures.Width) / 2

Micha
Bild

Betrifft: AW: Bild einfügen
von: Brit
Geschrieben am: 15.04.2005 14:08:08
Hallo Micha!
Ich habe das nun verändert und den Code durchlaufen lassen, aber das Bild in der ersten Zeile wird richtig verrückt!
Die restlichen Bilder bleiben an ihrer Position!
??????
Brit
Bild

Betrifft: AW: Bild einfügen
von: Micha

Geschrieben am: 15.04.2005 14:15:29
Hallo Brit,
versuch es mal so
Sub Bild_einfügen()
Application.ScreenUpdating = False
Dim code
Range("A:A").Activate
On Error Resume Next
Dim Zelle
For Each Zelle In Range("A:A")
If Zelle.Value = "" Then Exit For
Zelle.Activate
code = ActiveCell.Value
code = code & ".eps"
code = LCase(code)
ActiveCell.Offset(0, 2).Activate
pfad = ThisWorkbook.Path & "\" & code
ActiveSheet.Pictures.Insert (pfad)
dHeight = ActiveSheet.Pictures.Height
ActiveCell.Rows.RowHeight = dHeight
ActiveSheet.Pictures.Left = ActiveSheet.Pictures.Left + (ActiveCell.Width / 2) - (ActiveSheet.Pictures.Width / 2)
Next Zelle
Application.ScreenUpdating = True
End Sub

Bild

Betrifft: AW: Bild einfügen
von: Brit
Geschrieben am: 15.04.2005 14:19:48
Hallo Micha!
Leider noch keine Erfolgsnachricht!
Immer noch das gleiche Ergebnis wie vorher!
Erste Zeile richtig; der Rest unverändert!
Brit
Bild

Betrifft: AW: Bild einfügen
von: Micha

Geschrieben am: 15.04.2005 14:54:05
Hallo Brit,
jetz klappt es.
Ich hab es getestet. Viel spaß.
Sub Bild_einfügen()
Application.ScreenUpdating = False
Dim code
Range("A:A").Activate
On Error Resume Next
Dim Zelle
Dim i As Long
For Each Zelle In Range("A:A")
i = i + 1
code = Zelle.Value
code = code & ".jpg"
code = LCase(code)
Zelle.Offset(0, 2).Activate
pfad = ThisWorkbook.Path & "\" & code
ActiveSheet.Pictures.Insert (pfad)
dHeight = ActiveSheet.Pictures.Height
ActiveCell.Rows.RowHeight = dHeight
ActiveSheet.Pictures(i).Left = ActiveSheet.Pictures(i).Left + (ActiveCell.Width - ActiveSheet.Pictures(i).Width) / 2
If ActiveCell.Offset(1, -2) = "" Then Exit For
ActiveCell.Offset(1, -2).Activate
Next Zelle
Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: Bild einfügen
von: Micha
Geschrieben am: 15.04.2005 15:16:08
Hallo Brit,
entschuldige bitte
dHeight = ActiveSheet.Pictures(i).Height
muß natürlich auch geändert werden.
Micha
 Bild