Bild einfügen bei Aktivierung Zelle

Bei dem Klick auf bestimmte Zellen (Spalte D, I und N) wird ein Dialogfeld aufgerufen, in dem ich ein Bild auswählen kann, dass in die aktive Zelle eingefügt wird. Die Größe des Bildes wird dabei automatisch auf eine Höhe von 127 angepasst. Das folgende Makro funktioniert sehr gut.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("d7:d28, i7:i28, n7:n28")) Is Nothing Then
On Error Resume Next
Dim ObjektDLG As Dialog
Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture)
ObjektDLG.Show
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 127
End If
End Sub

Nun soll zusätzlich beim Anklicken von Zellen in den Spalten C, H und M ebenfalls ein Foto per Dialog ausgewählt werden und eingefügt werden. Dieses bekommt aber eine Höhe von 93. Wie kann ich das sinnvollerweise im Makro mit aufnehmen oder ein zweites Makro zusätzlich definieren, das auf den gewünschten Zellenbereich wirkt und so dass beide Makros funktionieren?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim ObjektDLG As Dialog Dim varBild If Not Intersect(ActiveCell, Range("d7:d28, i7:i28, n7:n28")) Is Nothing Then Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) If ObjektDLG.Show = -1 Then Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 127 End If ElseIf Not Intersect(ActiveCell, Range("c7:c28, h7:h28, m7:m28")) Is Nothing Then Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) If ObjektDLG.Show = -1 Then Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 93 End If End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("d7:d28, i7:i28, n7:n28, C7:C28, H7:H28, M7:M28")) Is Nothing _ Then On Error Resume Next Dim ObjektDLG As Dialog Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) ObjektDLG.Show Selection.ShapeRange.LockAspectRatio = msoTrue Select Case Target.Column Case Is = 5, 9, 14 Selection.ShapeRange.Height = 127 Case Is = 4, 8, 13 Selection.ShapeRange.Height = 93 End Select End If End Sub

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("C7:D28, H7:I28, M7:N28")) Is Nothing _ Then On Error Resume Next Dim ObjektDLG As Dialog Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) ObjektDLG.Show Selection.ShapeRange.LockAspectRatio = msoTrue Select Case Target.Column Case Is = 4, 9, 14 'Spalte D, I, N = großes Bild Selection.ShapeRange.Height = 127 Case Is = 3, 8, 13 'Spalte C, H, M = kleines Bild Selection.ShapeRange.Height = 93 End Select End If End Sub

Beliebteste Forumthreads (12 Monate)

Bild einfügen bei Aktivierung Zelle

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild einfügen bei Aktivierung Zelle

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread