Bild in verbundene Zelle einfügen

Private Sub cmd_picture_insert_Click() 'Dialogform aufrufen x = Application.Dialogs(xlDialogInsertPicture).Show 'Bild in markierter Zelle einfügen If x False Then Selection.Top = ActiveCell.Top Selection.Left = ActiveCell.Left 'Bild in max. Breite der Zelle einpassen xbreite = ActiveCell.Width Selection.ShapeRange.Width = xbreite Selection.ShapeRange.LockAspectRatio = False Selection.Placement = xlMoveAndSize Else 'Wenn kein Bild ausgewählt wurde ->MSgbox Meldung MsgBox "No image selected!! " End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub cmd_picture_insert_Click() Dim x, rngS As Range If Selection.Cells(1, 1).MergeArea.Cells.Count = 1 Then MsgBox "No merged cells selected!!", vbCritical, "Selection" Exit Sub End If Set rngS = Selection 'Dialogform aufrufen x = Application.Dialogs(xlDialogInsertPicture).Show 'Bild in markierter Zelle einfügen If x False Then With Selection .Top = rngS.Top .Left = rngS.Left .ShapeRange.Width = rngS.Width .ShapeRange.LockAspectRatio = False .Placement = xlMoveAndSize End With Else 'Wenn kein Bild ausgewählt wurde ->MSgbox Meldung MsgBox "No image selected!! " End If End Sub

Hi
wenn das Bild verzerrungsfrei in die Zelle oder den Zellverbund eingefügt werden soll, dann musst du das Höhen/Breitenverhältnis von Bild und Zelle miteinander vergleichen.
Wenn das Höhen/Breitenverhältnis des Bildes grösser ist als das der Zelle, musst du die Höhen anpassen und die Breite automatisch mitändern lassen.
Ist das Höhen/Breitenverhältnis kleiner als das der Zelle, musst du die Breite ändern.

Private Sub cmd_picture_insert_Click()
'Dialogform aufrufen
If Application.Dialogs(xlDialogInsertPicture).Show Then
'Bild in markierter Zelle einfügen
With ActiveCell.MergeArea
'--- Bildgrösse
If Selection.Height / Selection.Width > .Height / .Width Then
Selection.Height = .Height
Else
Selection.Width = .Width
End If
'--- Bildposition
Selection.Top = .Top
Selection.Left = .Left
'--- Bildeigenschaften
Selection.ShapeRange.LockAspectRatio = False
Selection.Placement = xlMoveAndSize
End With
Else
'Wenn kein Bild ausgewählt wurde ->MSgbox Meldung
MsgBox "No image selected!! "
End If
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Bild in verbundene Zelle einfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

414 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild in verbundene Zelle einfügen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

414 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread