Chỉnh ảnh vừa ô bằng VBA

[thang_nguyen1]

Các tiền bối giúp mình với. câu hỏi mình đã nêu trong file

 

[batman1]

Nếu bạn muốn viiết code cho Sub ResizePictureCells hiện có thì

Sub ResizePictureCells()
Dim pic As Shape
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.top = .top
            pic.left = .left
            pic.Width = .Width
            pic.Height = .Height
        End With
    Next pic
End Sub

 

[thang_nguyen1]

Nếu bạn muốn viiết code cho Sub ResizePictureCells hiện có thì

Sub ResizePictureCells()
Dim pic As Shape
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.top = .top
            pic.left = .left
            pic.Width = .Width
            pic.Height = .Height
        End With
    Next pic
End Sub

em muốn ảnh nhỏ hơn ô một chút thì làm như thế nào ạ

 

[batman1]

em muốn ảnh nhỏ hơn ô một chút thì làm như thế nào ạ

Tự thêm bớt delta

Sub ResizePictureCells()
Dim delta As Double, pic As Shape
    delta = 3
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.top = .top + delta
            pic.left = .left + delta
            pic.Width = .Width - 2 * delta
            pic.Height = .Height - 2 * delta
        End With
    Next pic
End Sub

 

[thang_nguyen1]

Tự thêm bớt delta

Sub ResizePictureCells()
Dim delta As Double, pic As Shape
    delta = 3
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.top = .top + delta
            pic.left = .left + delta
            pic.Width = .Width - 2 * delta
            pic.Height = .Height - 2 * delta
        End With
    Next pic
End Sub

Cảm ơn thầy rất nhiều ạ. Em đã làm file add-in rồi, rất tiện luôn!

 

[hungtin1997]

Tự thêm bớt delta

Sub ResizePictureCells()
Dim delta As Double, pic As Shape
    delta = 3
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.top = .top + delta
            pic.left = .left + delta
            pic.Width = .Width - 2 * delta
            pic.Height = .Height - 2 * delta
        End With
    Next pic
End Sub

Vậy với Merge Cells thì mình làm thế nào ạ?

 

[batman1]

Vậy với Merge Cells thì mình làm thế nào ạ?

Dùng cho toàn ô đơn, toàn ô kết hợp, và lẫn lỗn vừa có ô đơn vừa có ô kết hợp.

Option Explicit

Sub ResizePictureCells()
Dim delta As Double, pic As Shape
    delta = 3
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.Top = .MergeArea.Top + delta
            pic.Left = .MergeArea.Left + delta
            pic.Width = .MergeArea.Width - 2 * delta
            pic.Height = .MergeArea.Height - 2 * delta
        End With
    Next pic
End Sub

 

[Chuối Cả Nải]

Phần nay

Dùng cho toàn ô đơn, toàn ô kết hợp, và lẫn lỗn vừa có ô đơn vừa có ô kết hợp.

Option Explicit

Sub ResizePictureCells()
Dim delta As Double, pic As Shape
    delta = 3
    For Each pic In ActiveSheet.Shapes
        With pic.TopLeftCell
            pic.LockAspectRatio = 0
            pic.Top = .MergeArea.Top + delta
            pic.Left = .MergeArea.Left + delta
            pic.Width = .MergeArea.Width - 2 * delta
            pic.Height = .MergeArea.Height - 2 * delta
        End With
    Next pic
End Sub

Phần này đang chọn hết tất cả ảnh trong file của mình ( bao gồm cả logo, tiêu đề...)
Bác chỉnh giúp chỉ chọn 1 ảnh cần để resize được ko ạ?