Xin code VBA cho dữ liệu chèn ảnh (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

kimthoa89

Thành viên thường trực
Tham gia
3/11/17
Bài viết
219
Được thích
17
Giới tính
Nữ
Dear anh chị !
Cho em xin code VBA cho dữ lieu chèn ảnh ah
Trong file báo cáo của em có hơn 10 line, mỗi line 20 cái ảnh. mà làm thao tác thủ công rất lâu
Vì vậy trong foder của em có tất cả 7 ảnh, em muốn chèn ảnh theo số thứ tự trong ô
Và kích thước bằng nhau, như kích thước trong file excel ah
Em cảm ơn ah
 

File đính kèm

Lần chỉnh sửa cuối:
Dear anh chị !
Cho em xin code VBA cho dữ lieu chèn ảnh ah
Trong file báo cáo của em có hơn 10 line, mỗi line 20 cái ảnh. mà làm thao tác thủ công rất lâu
Vì vậy trong foder của em có tất cả 7 ảnh, em muốn chèn ảnh theo số thứ tự trong ô
Và kích thước bằng nhau, như kích thước trong file excel ah
Em cảm ơn ah
Tham khảo code dưới:
Mã:
Private Sub CommandButton1_Click()
Dim Cel As Range, Pic As Shape
On Error Resume Next
For Each Cel In Sheet1.Range("I7:Q25")
    If Cel <> "" Then
        For Each Pic In ActiveSheet.Shapes
            If Pic.TopLeftCell.Address = Cel.Address Then
                MsgBox Pic.TopLeftCell.Address
                Pic.Delete
            End If
        Next
        With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cel.Value & ".png")
            .Name = Cel.Value
            .Left = Cel.Left: .Top = Cel.Top
            .Width = Cel.Width: .Height = Cel.Height * 5
        End With
    End If
Next
End Sub
Nhớ đặt file hình trong Folder file Excel này.
 

File đính kèm

Tham khảo code dưới:
Mã:
Private Sub CommandButton1_Click()
Dim Cel As Range, Pic As Shape
On Error Resume Next
For Each Cel In Sheet1.Range("I7:Q25")
    If Cel <> "" Then
        For Each Pic In ActiveSheet.Shapes
            If Pic.TopLeftCell.Address = Cel.Address Then
                MsgBox Pic.TopLeftCell.Address
                Pic.Delete
            End If
        Next
        With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cel.Value & ".png")
            .Name = Cel.Value
            .Left = Cel.Left: .Top = Cel.Top
            .Width = Cel.Width: .Height = Cel.Height * 5
        End With
    End If
Next
End Sub
Nhớ đặt file hình trong Folder file Excel này.
cảm ơn anh ah
 
Web KT

Bài viết mới nhất

Back
Top Bottom