Excel 이미지 클릭으로 크기 전환

Martin·2024년 8월 5일
0

Excel

목록 보기
1/1

Sub 그림1_Click()

Dim shpOriginalWidth As Single
Dim shpOriginalHeight As Single
Dim shpCellWidth As Single
Dim shpCellHeight As Single
Dim isCellSize As Boolean

Dim shp As Shape
Dim big As Single, small As Single

   Dim tolerance As Single
       ' 비교 허용 오차 (픽셀 단위)
tolerance = 2
  On Error Resume Next
   
Dim shpDouH As Double, shpDouOriH As Double
big = 1
small = 1
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
On Error GoTo 0
   If shp Is Nothing Then Exit Sub




  ' 원본 크기 저장 (초기화)
If shpOriginalWidth = 0 And shpOriginalHeight = 0 Then
    shpOriginalWidth = shp.Width
    shpOriginalHeight = shp.Height
End If

' 셀 크기 저장
shpCellWidth = shp.TopLeftCell.Width
shpCellHeight = shp.TopLeftCell.Height

' 현재 이미지 크기 저장
Dim shpCurrentWidth As Single
Dim shpCurrentHeight As Single
shpCurrentWidth = shp.Width
shpCurrentHeight = shp.Height






With shp
    shpDouH = .Height
    .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
    shpDouOriH = .Height

    If Round(shpDouH / shpDouOriH, 2) = big Then
.LockAspectRatio = msoTrue
        .Width = shpCellWidth
        .Height = shpCellHeight
        .ZOrder msoSendToBack
        isCellSize = True
    Else
        .ScaleHeight big, msoTrue, msoScaleFromTopLeft
        .ScaleWidth big, msoTrue, msoScaleFromTopLeft
        .ZOrder msoBringToFront
    End If
End With

End Sub

0개의 댓글