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

Beiträge aus den Excel-Beispielen zum Thema "2 Dateien - Darensatz finden und anderen Wert aus "