Slika v sredini celice

[BJ]

Pozdravljeni!
Skopiram neko sliko in jo prilepim v izbrano celico. Slika se vedno poravna v zgornji levi kot, želel bi, da se postavi na sredino celice.
Hvala!

[BJ]

Koda: Izberi vse

Sub Prilepi_Sliko()
With Selection.Borders
      .LineStyle = xlDash
      .Color = -16776961
      .Weight = xlMedium
    End With
With Selection
   .ColumnWidth = 30
   .RowHeight = 114
   .Interior.Color = RGB(146, 208, 80)
End With
      ActiveSheet.Paste
With Selection
   .ShapeRange.LockAspectRatio = msoFalse
   .ShapeRange.Height = 113
   .ShapeRange.Width = 178
End With
End Sub

[admin]

Ja saj vi slike nikjer nikamor ne premaknete! In seveda ko jo vstavite v celico jo Excel premakne v gornji levi kot.

Vi morate torej najprej izračunati velikost celice in odšteti velikost slike ter to deliti z dva (da dobite sredino), potem pa na koncu sliko ustrezno premakniti!

Koda: Izberi vse

Sub Prilepi_Sliko()
  With Selection.Borders
    .LineStyle = xlDash
    .Color = -16776961
    .Weight = xlMedium
  End With
  
  With Selection
    .ColumnWidth = 50
    .RowHeight = 200
    .Interior.Color = RGB(146, 208, 80)
  End With
  
  Dim xOs As Double: xOs = Selection.Width
  Dim yOs As Double: yOs = Selection.Height
  
  ActiveSheet.Paste
  With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 113
    .ShapeRange.Width = 178
  End With
  
  xOs = (xOs - Selection.ShapeRange.Width) / 2
  yOs = (yOs - Selection.ShapeRange.Height) / 2

  Selection.ShapeRange.IncrementLeft xOs
  Selection.ShapeRange.IncrementTop yOs
End Sub

[BJ]

Vi morate torej najprej izračunati velikost celice in odšteti velikost slike ter to deliti z dva (da dobite sredino), potem pa na koncu sliko ustrezno premakniti!

Čisto nič mi ni bilo jasno, kako izračunati velikost celice in ....., vendar je uspelo.
Najlepša hvala za pomoč.