AW: Makro mit bestimmter Taste starten
09.04.2012 15:38:37
Mike
Hallo Hajo,
momentan verwende ich dort folgenden Code zur Anzeige von Bildern - kann ich das denn kombinieren ?
Option Explicit
Const imagePath As String = "C:\Users\Notebook\Desktop\My Documents\Bilder\"
'Image saving location
Const MaxWidth As Long = 412 'Maximum width for images
Const MaxHeight As Long = 259 'Maximum height for images
Const PosLeft As Long = 551 'Image location from left
Const PosTop As Long = 137 'Image location from top
Private objImg As Object
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Action 1: displays matching image if click on corresponding entry in column C
' Action 2: shows message box with error message if no matching image found
' Action 3: deletes displayed image if click elsewhere than column C
Dim dblWidth As Double, dblHeight As Double
Dim strFile As String
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"
strFile = Replace(Replace(strFile, vbLf, ""), vbCrLf, "")
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
VG
Mike