Căn chỉnh hình ảnh cho vừa ô

[hungldbka]

Xin chào mọi người, em mới tập tành VBA ạ, Hiện em đang có một một vấn đề là em có khá nhiều ảnh trong 1 sheet muốn căn cho vừa ô, và em có tìm được 1 đoạn cod khá hay nhưng em gặp phải 2 vấn đề là: 1 Cod chỉ đúng với những ảnh không xoay hình( trong khi đó em có 1 số ảnh phải để ở chế độ xoay 90 độ nên cod chạy sai); 2 là em muốn cod tự động quét hết tất cả ảnh trong sheet và căng vừa ô ạ. Mong được mọi người giúp đỡ ạ. Dưới đây là đoạn cod của một cao thủ mà em tìm được ạ:
Public Sub FitPic2()

Dim pic As Picture
If TypeOf Selection Is Picture Then
Set pic = Selection
Pic2Cel pic, pic.TopLeftCell, 1
Else
MsgBox "Chon anh truoc khi click"
End If
End Sub
Private Sub Pic2Cel(ByVal pic As Picture, ByVal cel As Range, Optional ByVal dScale As Double = 1)
Dim dist As Double, dWith As Double, dHeight As Double
dWith = cel.Width * dScale
dist = (cel.Width - dWith) / 2
dHeight = cel.Height - 2 * dist
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Placement = xlMoveAndSize
.Left = cel.Left + dist: .Top = cel.Top + dist
.Height = dHeight
.Width = dWith
End With
End Sub

Còn đây là ảnh tài liệu của em ạ:

 

[hungldbka]

Hiện em đãlàm được điều thứ 2 nhưng điều thứ 1 vẫn chưa xong, mong được giúp đỡ ạ:


Public Sub Canchinhhinhanh()
Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Select
Pic2Cel Pic, Pic.TopLeftCell, 1
Next Pic
End Sub
Private Sub Pic2Cel(ByVal Pic As Picture, ByVal cel As Range, Optional ByVal dScale As Double = 1)
Dim dist As Double, dWith As Double, dHeight As Double
If Pic.ShapeRange.Rotation = 0 Then
dWith = cel.Width * dScale
dist = (cel.Width - dWith) / 2
dHeight = cel.Height - 2 * dist
With Pic
.ShapeRange.LockAspectRatio = msoFalse
.Placement = xlMoveAndSize
.Left = cel.Left + dist: .Top = cel.Top + dist
.Height = dHeight
.Width = dWith
End With
Pic.ShapeRange.LockAspectRatio = msoTrue
Else
MsgBox "Hinh bi xoay roi"
End If
End Sub