Trợ giúp code VBA (1 người xem)

[tvphong192]

Mình có đoạn code này khi chạy thì ảnh được chọn sẽ canh đều vừa trong 1 ô đó.Mình muốn mọi người giúp đỡ sửa code để có thể chọn nhiều ảnh để chạy cùng một lúc ạ!
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'

If TypeName(Selection) = "Picture" Then
With Selection
.ShapeRange.LockAspectRatio = False
.Height = .TopLeftCell.Height - 10
.Width = .TopLeftCell.Width - 10
.Top = .TopLeftCell.Top + 5
.Left = .TopLeftCell.Left + 5
End With
Else
MsgBox "Chon anh truoc di."
End If
End Sub

 

[HieuCD]

Mình có đoạn code này khi chạy thì ảnh được chọn sẽ canh đều vừa trong 1 ô đó.Mình muốn mọi người giúp đỡ sửa code để có thể chọn nhiều ảnh để chạy cùng một lúc ạ!
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'

If TypeName(Selection) = "Picture" Then
With Selection
.ShapeRange.LockAspectRatio = False
.Height = .TopLeftCell.Height - 10
.Width = .TopLeftCell.Width - 10
.Top = .TopLeftCell.Top + 5
.Left = .TopLeftCell.Left + 5
End With
Else
MsgBox "Chon anh truoc di."
End If
End Sub

Thử code . . . . .

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
  Dim pic As Variant
  If TypeName(Selection) = "Picture" Then
    Call ABC(Selection)
  ElseIf TypeName(Selection) = "DrawingObjects" Then
    For Each pic In Selection
      If TypeName(pic) = "Picture" Then Call ABC(pic)
    Next pic
  Else
        MsgBox "Chon anh truoc di."
  End If
End Sub

Private Sub ABC(ByVal pic As Variant)
  With pic
    .ShapeRange.LockAspectRatio = False
    .Height = .TopLeftCell.Height - 10
    .Width = .TopLeftCell.Width - 10
    .Top = .TopLeftCell.Top + 5
    .Left = .TopLeftCell.Left + 5
  End With
End Sub

 

[tvphong192]

Mình cảm ơn nhé!!!code đã chạy được rồi