AW: Bilder in Excel-Bestellliste bringen?
26.01.2005 15:20:13
Oliver
Ich will ja nicht über Einfügen/Grafik gehen, da die Grafik eben nicht einer Zelle ganz explizit zugeordnet ist.
Aber ich habe gerade zwei Codeschnipsel gefunden, weiss allerdings nicht wie ich diesen Code einfügen muss es ist VBA.
Grüße,
Oliver
1. Snip >>>>
Option Explicit
Public Const ORDNER = "C:\Bilder"
Public Const FILTER As String = "jpg"
Public Const ROW_START As Long = 3
Public Const COL_START As Integer = 2
Public Const COL_MAX As Integer = 5
Public
Sub Main()
On Error GoTo Err_In_Test
Dim zeile As Long, spalte As Integer, fehlerhaft As String
Dim fso As Object
Dim fld As Object
Dim fi As Object
Application.ScreenUpdating = False
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(ORDNER)
fehlerhaft = ""
zeile = ROW_START
spalte = COL_START
For Each fi In fld.Files
If (VBA.UCase(VBA.Right(fi.Name, 3)) = VBA.UCase(FILTER)) Then
Cells(zeile, spalte).Activate
If (InsertPicture(ActiveCell, fi.Path) = False) Then
fehlerhaft = fehlerhaft & fi.Name & VBA.Constants.vbCrLf
Else
If (spalte = COL_MAX) Then
zeile = zeile + 1
spalte = COL_START
Else
spalte = spalte + 1
End If
End If
End If
Next fi
If (fehlerhaft <> "") Then VBA.MsgBox "Fehlerhaften Bilder : " & VBA.Constants.vbCrLf & _
fehlerhaft, vbExclamation, "fehlerhaft"
Application.ScreenUpdating = True
Exit Sub
Err_In_Test:
MsgBox "Error " & Err.Number, vbCritical, "severe"
End Sub
Public
Function InsertPicture(ByVal zelle As Range, ByVal pfad As String) As Boolean
On Error GoTo Err_In_InsertPicture
InsertPicture = False
Dim ole_picture As OLEObject
Set ole_picture = zelle.Parent.OLEObjects.Add(ClassType:="Forms.Image.1")
With ole_picture.Object
.Picture = LoadPicture(pfad)
.AutoSize = False
End With
With ole_picture
.Placement = xlFreeFloating
.Top = zelle.Top
.Left = zelle.Left
.Height = zelle.Height
.Width = zelle.Width
End With
InsertPicture = True
Set ole_picture = Nothing
Exit Function
Err_In_InsertPicture:
End Function
2. Snip >>>>
Option Explicit
Sub Bild_einfuegen()
Dim Bild As Object, Zelle As Range
On Error Resume Next
Set Zelle = ActiveCell
Set Bild = ActiveSheet.Pictures.Insert("C:\Eigene Bilder\Bild1.jpg")
With Bild
.Placement = 2
.Left = Zelle.Left
.Top = Zelle.Top
.Width = Zelle.Width
.Height = Zelle.Height
End With
End Sub