Grafik in Zelle formatieren
25.02.2006 00:40:21
foerthner
folgende Problemstellung:
Bilder aus einer externen DatenQuelle in Excel Spalte "A" importieren auf
Basis der in Spalte "B" angegebenen Bildnummer.
d.h. A1= importiertes Bild B1 = Bildnummer
Dieses Problem hat bereits ein anderer findiger in einem fremden Forum gelöst.
Ich will mich auch nicht mit fremden Lorbeeren schmücken. Das Problem ist, dass manche Bilder (verschiedene Auflösungen und Grössen) zu gross in der Spalte angezeigt werden und auch nicht mittig in der Zelle dargestellt werden, sondern linksbündig oben. Hat vielleicht in diesem Forum eine Idee wie ich das gebacken krieg:
Hier der aktuelle Code:
___________________________________________________________________________
Private Const BildVerzeichnis As String = "Z:\Fotos\"
Private Const BildHoehe As Single = 80
Private Const BildBreite As Single = 80
Private Const TextNV As String = "[War wohl nix]" ' "" ' Text in zelle, wenn Bild nicht vorhanden
Private Const Ext As String = ".jpg" ' Extension der Bilddateien (wenn's nicht in der tabelle steht)
Sub Angebot_Bild_holen()
Dim Z As Long, Bild As String
Z = 17
Do
Z = Z + 1
Bild = Cells(Z, 2).Value
If Bild = "" Then Exit Do
Cells(Z, 1).Select
BildEinfuegen BildVerzeichnis & Bild & Ext, ActiveCell
Loop
End Sub
Sub BildEinfuegen(ByVal Pfad As String, ByRef R As Range)
R.Select
On Error Resume Next
'Debug.Print Pfad, Dir(Pfad) ' zum Testen...
If Pfad = "" Or Dir("Z:\Fotos\") = "" Then
R.Formula = TextNV ' kein Bild vorhanden
Else
ActiveSheet.Pictures.Insert(Pfad).Select
'Selection.ShapeRange.LockAspectRatio = msoTrue ' seitenverhältnis bewahren
Selection.ShapeRange.Height = BildHoehe ' Höhe aller Bilder
Selection.ShapeRange.Width = BildBreite ' Breite aller Bilder
R.Select
End If
On Error GoTo 0
End Sub
______________________________________________________________________________
Ich wäre überaus dankbar für eine Lösung bzw. Hilfestellung
Gerhard