AW: Bitte um Hilfe bei Codezeile
20.05.2012 15:14:38
Marco
Hallo Gerd,
hier noch der komplette Codeteil des Tabellenblattes als Ergänzung - vielleicht hilft das ja weiter:
Option Explicit
Const imagePath As String = "C:\Users\Notebook\Bilder\"
'Image saving location
Const MaxWidth As Long = 471 'Maximum width for images
Const MaxHeight As Long = 500 'Maximum height for images
Const PosLeft As Long = 553 'Image location from left
Const PosTop As Long = 143 'Image location from top
Private objImg As Object
Dim mstrOld As String
Dim RaBereich As Range
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dblWidth As Double, dblHeight As Double
Dim strFile As String
Set RaBereich = Intersect(Range("E2"), Range(Target.Address))
If Not RaBereich Is Nothing Then
mstrOld = Range("E2")
End If
If Not objImg Is Nothing Then objImg.Visible = False
DoEvents
If Target.Column = 3 And Target.Count = 1 Then
If Target "" Then
strFile = imagePath & IIf(Right(imagePath, 1) "\", "\", "") & Target.Value & ".jpg"
If InStr(strFile, vbLf) > 0 Then
strFile = Left(strFile, InStr(strFile, vbLf) - 1)
End If
If Dir(strFile) "" Then
On Error Resume Next
If objImg Is Nothing Then Set objImg = Me.OLEObjects("imageContainer")
On Error GoTo 0
If objImg Is Nothing Then createImageContainer
With objImg
.Object.AutoSize = True
.Object.Picture = LoadPicture(strFile)
.Top = ActiveWindow.VisibleRange.Top + PosTop
.Left = PosLeft
If .Height > MaxHeight Or .Width > MaxWidth Then
.Object.AutoSize = False
dblWidth = MaxWidth / .Width
dblHeight = MaxHeight / .Height
If dblWidth
Private Sub createImageContainer()
Set objImg = Me.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=0, Top:=0, Width:=0, Height:=0)
With objImg
.Visible = False
.Object.PictureSizeMode = 1
.Name = "imageContainer"
End With
End Sub
Die Funktion ist in einem Modul wie folgt abgelegt:
Option Explicit
Function Vorh(Zelle) As Boolean
Dim Z
Const Pfad = "C:\Users\Notebook\Desktop\My Documents\Bilder\"
Z = Replace(Zelle.Value, Chr(11), "")
Vorh = Dir(Pfad & Zelle & ".jpg") ""
End Function
'
VG und nochmals danke,
Marco