[Hỏi VBA] Chèn hình ảnh tự động vào Excel bằng VBA - Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng

8/1/2016 21:37 Tải lên

Click to download
Các bạn tải file đính kèm về nhé !
- Như tiêu đề đã nói, mình muốn các bạn giúp mình tạo một code VBA chèn hình ảnh tương ứng với nội dung, giá trị có sẵn.
ví dụ cho dễ hiểu: ô A1 có Giá trị 1, ô B1 có Nội dung 1, thì tại ô C1 VBA sẽ chèn Hình ảnh 1 vào đó; v.v...
- Mình cũng đã tạo được VBA qua cách thu macro như sau, nhưng chưa đúng ý cho lắm, cái mình cần là ảnh "pic1.jpg" sẽ được thay đổi khi giá trị ô A1 thay đổi
- Diễn đạt không biết có đủ ý không nữa. Hy vọng có ai đó hiểu đúng ý

[Visual Basic] 纯文本查看 复制代码

Sub chen_hinh()

'

' chen_hinh Macro

'



'

    ActiveSheet.Pictures.Insert("E:\PIC_XD\pic1.jpg").Select

    Range("D6").Select

End Sub

Tác giả: tranhungdao12a3 Thời gian: 10/1/2016 12:40
Xài vầy đi. Muốn để ổ E thì di chuyển Foler Pic_xd qua ổ E:

[Visual Basic] 纯文本查看 复制代码

Option Explicit

Function CommPic(Pic As String, Cel As Range) As String

  On Error Resume Next

  Application.Volatile

  Cel.Comment.Delete

  If Cel.Comment Is Nothing Then Cel.AddComment

  Cel.Comment.Text vbLf

  With Cel.Comment.Shape

    .Left = Cel.Left: .Top = Cel.Top: .Visible = True

    .Width = Cel.Width: .Height = Cel.Height

    .Fill.UserPicture Pic

  End With

End Function

chen_anh.xlsm (36.78 KB, Lượt tải về: 3670)

10/1/2016 12:40 Tải lên

Click to download

Tác giả: tranhoe Thời gian: 10/1/2016 14:59
Để có kết quả đúng thì file này và các ảnh minh họa phải cùng nằm trong 1 thư mục (có tên bất kỳ không nhất thiết là E:\PIC_XD). Có nghĩa là chép file đính kèm vào thư mục chứa các hình ảnh minh họa, xong mở file.
Trên cơ sở trả lời của @tranhungdao12a3 mình sửa tí xíu cho phù hợp với ý của chủ topic:

[Visual Basic] 纯文本查看 复制代码

Function CommPic(Cell1 As Range, Cell2 As Range) As String

  On Error Resume Next

  Application.Volatile

  Cell2.Comment.Delete

  If Cell2.Comment Is Nothing Then Cell2.AddComment

  Cell2.Comment.Text vbLf

  With Cell2.Comment.Shape

    .Left = Cell2.Left: .Top = Cell2.Top: .Visible = True

    .Width = Cell2.Width: .Height = Cell2.Height

    .Fill.UserPicture ThisWorkbook.Path & "\Pic" & Cell1.Value & ".jpg"

  End With

End Function

file:

chen_anh_V1.xlsm (23.51 KB, Lượt tải về: 3304)

10/1/2016 14:59 Tải lên

Click to download

Tác giả: vantuan18nd Thời gian: 10/1/2016 20:16
VBA thật kỳ diệu !
Xin lỗi vì đã trả lời bài muộn.
Cảm ơn tất cả mọi người nhiều. Hoàn toàn đúng ý cháu rồi !

Tác giả: tranhoe Thời gian: 10/1/2016 20:59

tranhungdao12a3 gửi lúc 10/1/2016 12:40
Xài vầy đi. Muốn để ổ E thì di chuyển Foler Pic_xd qua ổ E:

[mw_shl_code=vb,true]Option E ...

Hay quá Bạn ơi!.
Hay nhất là lệnh nầy: " Cell.Comment.Delete".
Nếu không thì ảnh cứ chèn vào mà chỉ có 1 ảnh là Activate mà thôi, xài 1 thời gian file quá nặng mở không nổi.
Khen thật tình đó nhé!

Tác giả: vantuan18nd Thời gian: 11/1/2016 14:00

tranhoe gửi lúc 10/1/2016 20:59
Hay quá Bạn ơi!.
Hay nhất là lệnh nầy: " Cell.Comment.Delete".
Nếu không thì ảnh cứ ch ...

Em hỏi thêm ạ, với cả hai cách trên, khi muốn hình ảnh xuất hiện ở ô khác thì phải thay ở dòng nào ạ.
Thanks

Tác giả: tranhoe Thời gian: 11/1/2016 14:22

vantuan18nd gửi lúc 11/1/2016 14:00
Em hỏi thêm ạ, với cả hai cách trên, khi muốn hình ảnh xuất hiện ở ô khác thì phả ...

Ví dụ: muốn có hình ở ô E7
Ghi công thức ô E7 =CommPic(A7;E7)
Vậy thôi

Tác giả: traihanam218 Thời gian: 23/6/2016 13:25
Cho em hỏi chèn ảnh xong vào excel mà muốn in ra có cả hình nữa thì làm thế nào ạ.@@

Tác giả: tranhoe Thời gian: 23/6/2016 20:11

traihanam218 gửi lúc 23/6/2016 13:25
Cho em hỏi chèn ảnh xong vào excel mà muốn in ra có cả hình nữa thì làm thế nào ạ.@@ ...

Nếu Em biết đọc câu lệnh thì sẽ hiểu rằng Function CommPic ở trên chèn Comment vào cells. Mà đã là Comment thì mặc định là không thấy được khi in ra. Xem cách xử lý để in ở bài 10# bên dưới
Tôi đưa ra hướng xử lý là chèn ảnh thật vào cells, sử dụng sự kiện Worksheet_Change khi thay đổi giá trị tại ô A1

[Visual Basic] 纯文本查看 复制代码

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim Shp As Shape

    Dim rngZ As Range

    If Target.Row <> 1 And Target.Column <> 1 Then Exit Sub

    'Bay loi Su kien

    Application.EnableEvents = False

    'Xoa cac Shape dang ton tai tren sheet

    For Each Shp In ActiveSheet.Shapes

        Shp.Delete

    Next

    Range("D4").Select

    'Bat dau chen hinh anh

    Do Until ActiveCell.Offset(0, -3).FormulaR1C1 = vbNullString

        ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\Pic" & ActiveCell.Offset(0, -3).Value & ".jpg").Select

        With Selection

            Set rngZ = .TopLeftCell

            .ShapeRange.ScaleHeight rngZ.Height / .Height, msoFalse

            .ShapeRange.ScaleWidth rngZ.Width / .Width, msoFalse

            .PrintObject = True

        End With

        rngZ.Offset(1, 0).Select

    Loop

    Application.EnableEvents = True

End Sub

File đính kèm:

chen_anh_V2.xlsm (25.62 KB, Lượt tải về: 3004)