Chèn hình ảnh tự động vào excel

[dhn46]

Một cách cho bạn tham khảo

 

[hieuxd]

Nhờ các thầy và mọi người chỉ giúp cách chèn hình hình vẽ Autoshapes bên sheet: ThuVienHinh sang Sheet:ThongKe
Do thường xuyên chèn thêm hình nên em muốn chèn theo kiểu hàm Vlookup, Khi em nhập mã hiệu trùng với mã hiệu bên ThuVien thì hình bên sheet ThuVien được chèn qua cột bên cạnh của Sheet: ThongKe
Dùng hàm không giải quyết được các thầy và mọi người giúp em một hàm tự tạo bằng VBA với,
Em đang nghĩ dùng list trong Data validation nhưng vẫn nghĩ chưa ra

 

[bbq1401]

Gửi các anh trên diễn đàn giải pháp excel.
Em có 1 file in khuyến mại. Em đã làm VLOOKUP các thông tin rồi. Bây giờ em muốn chèn các ảnh vào sheets đó.
Các Anh giúp em với

 

[hieuxd]

Nhờ các thầy và mọi người chỉ giúp cách chèn hình hình vẽ Autoshapes bên sheet: ThuVienHinh sang Sheet:ThongKe
Do thường xuyên chèn thêm hình nên em muốn chèn theo kiểu hàm Vlookup, Khi em nhập mã hiệu trùng với mã hiệu bên ThuVien thì hình bên sheet ThuVien được chèn qua cột bên cạnh của Sheet: ThongKe
Dùng hàm không giải quyết được các thầy và mọi người giúp em một hàm tự tạo bằng VBA với,
Em đang nghĩ dùng list trong Data validation nhưng vẫn nghĩ chưa ra

Nhờ các thầy và anh chị xem giúp em vấn đề này với
Giờ em mới biết mình gửi nhầm Box
phải gửi sang Box VBA mới đúng

 

[ntvuongq9]

Mình có một file excel chèn hình băng VBA nhưng khi copy sang file khac để gửi mail mà người nhận không thể xem được hình trong file đó. Mong các sư phụ chỉ dẩn giup ah!

 

[dalat2010]

Xin chào các bạn trên diễn đàn và bác ndu96081631.
Mình có câu hỏi mong nhận được sự giúp đỡ của các bạn. Mình làm như bác ndu96081631 hướng dẫn nhưng vẫn ko load hình được. Mình gửi kèm trang mẫu. Vì hình ảnh của mình rất năng nên không gửi lên đước. Tất cả hình ảnh trong các thư mục đặt theo thứ tự từ 1-40. Các bạn giúp giùm mình khi chép file excel này vào thư mục thì nó tự động load toàn bộ hình vào excel. và khi đưa file excel vào thư mục hình ảnh khác thì nó cũng tự động lấy như vậy. Cảm ơn các bạn rất nhiều.

 

[nguoimayman2003]

Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar

 

[ndu96081631]

Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar

Bạn xem bài viết này là tự nhiên biết cách làm liền:
http://www.giaiphapexcel.com/forum/showthread.php?51408-Chèn-hình-vào-cell-bằng-hàm-tự-tạo

 

[dalat2010]

Bác ndu96081631 và các bạn giúp mình với, thử nhiều lần vẫn không đưa được hình ảnh vào .

 

[dhn46]

Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar

Bạn tham khảo tiện ích In Form hàng loạt, link tại chữ ký của tôi

Đây là file của bạn

 

[hoangvu330]

Có Data rồi thì dể làm thôi

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, PicName As String
  Application.ScreenUpdating = False
  On Error Resume Next
  If Not Intersect([R2], Target) Is Nothing Then
    Set Rng = Sheet3.Range(Sheet3.[B1], Sheet3.[T65536].End(xlUp))
    PicName = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 20)
    Sheet1.Shapes(PicName).Delete
    With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName)
     .Name = PicName
     .Left = [B12:L22].Left: .Top = [B12:L22].Top
     .Width = [B12:L22].Width: .Height = [B12:L22].Height
   End With
  End If
End Sub

Tôi giả lập 26 tấm ảnh, bạn phải sửa lại cho phù hợp nha

anh ơi cho em hỏi thử:
Em có nhiều mã hàng ,mỗi mã có hình ảnh khác nhau.Vậy trong 1 sheet liệt kê nhiều mã hàng,khi mình đánh mã hàng nào vào thì sẽ hiện ra hình ảnh của mã hàng đó ở cột bên cạnh đc ko anh

 

[ndu96081631]

anh ơi cho em hỏi thử:
Em có nhiều mã hàng ,mỗi mã có hình ảnh khác nhau.Vậy trong 1 sheet liệt kê nhiều mã hàng,khi mình đánh mã hàng nào vào thì sẽ hiện ra hình ảnh của mã hàng đó ở cột bên cạnh đc ko anh

Tùy theo dữ liệu mà sửa code cho phù hợp chứ
Dùng cái này:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, PicName As String
  Application.ScreenUpdating = False
  On Error Resume Next
  If Not Intersect(Range("A6:A100"), Target) Is Nothing Then
    If Target.Count = 1 Then
      PicName = Target.Address(0, 0)
      ActiveSheet.Pictures(PicName).Delete
      With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
       .ShapeRange.LockAspectRatio = False
       .Name = PicName
       .Left = Target.Offset(, 3).Left: .Top = Target.Offset(, 3).Top
       .Width = Target.Offset(, 3).Width: .Height = Target.Offset(, 3).Height
     End With
   End If
  End If
End Sub

 

[Kh Biet]

Tùy theo dữ liệu mà sửa code cho phù hợp chứ
Dùng cái này:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, PicName As String
  Application.ScreenUpdating = False
  On Error Resume Next
  If Not Intersect(Range("A6:A100"), Target) Is Nothing Then
    If Target.Count = 1 Then
      PicName = Target.Address(0, 0)
      ActiveSheet.Pictures(PicName).Delete
      With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
       .ShapeRange.LockAspectRatio = False
       .Name = PicName
       .Left = Target.Offset(, 3).Left: .Top = Target.Offset(, 3).Top
       .Width = Target.Offset(, 3).Width: .Height = Target.Offset(, 3).Height
     End With
   End If
  End If
End Sub

Thày cho hỏi : Liệu thày có thể viết code để phóng to ảnh khi kích chuột và trở lại bình thường khi di chuyển chuột ra khỏi ảnh không ạ ?

 

[ndu96081631]

Thày cho hỏi : Liệu thày có thể viết code để phóng to ảnh khi kích chuột và trở lại bình thường khi di chuyển chuột ra khỏi ảnh không ạ ?

Ủa! Cái này đã làm mấy hôm trước rồi mà! Bài 105:
http://www.giaiphapexcel.com/forum/showthread.php?3721-Thêm-1-dạng-PicForm&p=536728#post536728

 

[Kh Biet]

Ủa! Cái này đã làm mấy hôm trước rồi mà! Bài 105:
http://www.giaiphapexcel.com/forum/showthread.php?3721-Thêm-1-dạng-PicForm&p=536728#post536728

Dạ, vì 2 cách load ảnh khác nhau, ở trang trên load ảnh toàn bộ folder, ở trang này load ảnh theo từng tên nhất định ạ ? sửa từ link trên phóng ảnh theo bài này khó quá, nó không chạy ạ !

 

[kennis]

Da thua anh, Vi sao khi in ra hinh anh lai ko hien duoc len vay anh? Em co 1 VBA nay nhung ko biet chay nhu the nao anh co the giai thich va chi giup em, sau khi cai dat VBA nay thi em nen dung cong thuc nao de chay duoc khong ah? Em cam on anh

Function LOT_PIC_PAC(LOT As String, DESTINATION_CELLS As Range, Optional PIC_BORDER As Boolean, Optional PIC_SHADOW As Boolean, Optional ENFORCE_SIZE As Boolean)
LOT_PIC_PAC = "Pic " & LOT

On Error GoTo SKIPIF
If DESTINATION_CELLS.Parent.Shapes(DESTINATION_CELLS.Address).AlternativeText = LOT Then Exit Function
DESTINATION_CELLS.Parent.Shapes(DESTINATION_CELLS.Address).Delete
SKIPIF:


Dim LFT As Double, TP As Double, WDTH As Double, HGT As Double, PIC As Object, i%
Dim FILEPATH(0 To 7) As String, PIC_NAME$
On Error GoTo 0
On Error GoTo EndIt
If LOT <> "0" Then
LFT = DESTINATION_CELLS.Left
TP = DESTINATION_CELLS.Top
WDTH = DESTINATION_CELLS.Width * 0.98
If DESTINATION_CELLS.Rows.Count > 1 Then WDTH = WorksheetFunction.Min(WDTH, DESTINATION_CELLS.Height / 1.41)
HGT = WDTH * 1.41
If ENFORCE_SIZE = True Then
WDTH = DESTINATION_CELLS.Width * 0.98
HGT = DESTINATION_CELLS.Height
End If
FILEPATH(0) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\ NoPicture.JPG"
If VBA.Environ("Username") = "Hoang Oanh" Then

FILEPATH(1) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"

Else

FILEPATH(1) = "\\OANH-PC\ D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
End If
FILEPATH(2) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(3) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(4) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(5) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(6) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(7) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"

For i = 1 To UBound(FILEPATH, 1)
If VBA.IsNumeric(LOT) = True Then
PIC_NAME = Dir(FILEPATH(i) & Format(LOT, "000000") & "*")
Else
PIC_NAME = Dir(FILEPATH(i) & LOT & "*")
End If
If PIC_NAME <> "" Then
FILEPATH(0) = FILEPATH(i) & PIC_NAME
Exit For
End If
PIC_NAME = Dir(FILEPATH(i) & LOT & "*")
If PIC_NAME <> "" Then
FILEPATH(0) = FILEPATH(i) & PIC_NAME
Exit For
End If
If i = UBound(FILEPATH, 1) Then LOT_PIC_PAC = "Pic " & LOT & " not found"
Next i
On Error GoTo EndIt
If VBA.Right(FILEPATH(0), 4) = ".xls" Then GoTo EndIt
Set PIC = DESTINATION_CELLS.Parent.Shapes.AddPicture(FILEPATH(0), False, True, LFT, TP, WDTH, HGT)
PIC.Name = DESTINATION_CELLS.Address
PIC.AlternativeText = LOT
If PIC_BORDER = True Then PIC.DrawingObject.ShapeRange.Line.DashStyle = msoLineSolid
If PIC_SHADOW = True Then PIC.Shadow.Visible = True
End If
EndIt:
On Error GoTo 0
End Function

 

[duynhat84]

Bác Ndu ơi hình thì cò rồi nhưng in ra không có, bác chỉ cho em làm cách nào để khi ra có hình với.
em cảm ơn nhiều.

 

[toanthang85]

Xin chào mọi người. xin các pro giúp đỡ. em muốn chèn ảnh tự động từ các file ảnh trên máy tính của mình vào excel 2010. nhưng em không biết làm thế nào cả. các bác pro gúp em với nhé. thanks all? em đang làm giùm ông anh chèn ảnh nghiệm thu vào file. mà copy chèn từng ảnh thủ công lâu quá.

 

[haiduongck2]

Bác có thể giải thích nghĩa các dòng lệnh đc k ạ,em làm theo tương tự trên sheet mới nhưng không đc, nó báo k hiển thị được hình ảnh. Cảm ơn bác

 

[bienthuong]

Em chào anh ndu96081631 ạ!
Em có xem các bài viết của Anh nhưng vẫn chưa biết cách làm. Em muốn nhờ Anh giúp đỡ giải thích giúp em cách chèn ảnh vào bảng tính, khi thay đổi mã ID thì ảnh cũng thay đổi theo ...

Bảng của em đây ạ, rất mong được giúp đỡ !