Xin code chèn hình vào bảng tính khi chọn họ tên trong danh sách của combobox động ? (1 người xem)

[Backy1990]

Chào các bác!
Em có 1 danh sách nhân viên, trong đó có cột chỉ đường dẫn đến thư mục chứa ảnh chụp của họ
Nhờ các bác viết giùm em cái code trong combobox để khi click chọn tên nhân viên nào thì ảnh của người đó hiện vừa khít vào khung ảnh theo theo đường dẫn đã cho.
Cảm ơn các bác thật nhiều!!!

 

[Hoàng Trọng Nghĩa]

Để chèn hình được thì phải có hình là đương nhiên, nhưng nếu không có hình thì File sẽ bị lỗi, vậy thì phải có hàm để nhận biết hình (file/ folder) có tồn tại hay không:

Function FileExist(ByVal filePath As String) As Boolean
    FileExist = CreateObject("Scripting.FileSystemObject").FileExists(filePath)
End Function

Với Form của bạn, ComboBox lấy nguồn bằng RowSource thì với bài tôi hướng dẫn sẽ nạp cho nó bằng List khi khởi động form (lưu ý, khi dùng thủ tục dưới đây thì phải xóa thuộc tính RowSource, nếu không sẽ phát sinh lỗi):

Private Sub UserForm_Initialize()
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Dim Arr, iC, CboList, i As Long
    iC = Array(0, 2, 1, 3, 4, 5, 6, 7)
    Arr = Range(DANH_SACH.[B3], DANH_SACH.[B65536].End(xlUp)).Resize(, 7).Value
    ReDim CboList(1 To UBound(Arr), 1 To 7)
    For i = 1 To UBound(Arr)
        For j = 1 To 7
            CboList(i, j) = Arr(i, iC(j))
        Next
    Next
    HoTen.List() = CboList
    HoTen.DropDown
End Sub

Để chèn hình vô sheet, ta có thủ tục sau:

Private Sub PictInsert()
    On Error Resume Next
    Dim PicName As String, NoPict As String, Hinh As String
    NHAN_VIEN.Shapes("HoangTrongNghia").Delete
    PicName = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & HoTen.Column(1) & ".jpeg"
    NoPict = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & "NoPict.GIF"
    If FileExist(PicName) Then Hinh = PicName Else Hinh = NoPict
    With NHAN_VIEN.Pictures.Insert(Hinh)
        .Name = "HoangTrongNghia"
        .Top = NHAN_VIEN.[C4].Top: .Left = NHAN_VIEN.[C4].Left
        .Height = NHAN_VIEN.[C4:C7].Height: .Width = NHAN_VIEN.[C4].Width
    End With
End Sub

Ở đây tôi có thêm 1 cái tên là NoPict, đây là hình tôi thêm vào cho bạn, nếu không có hình thì sẽ hiện cái picture này.

Và cuối cùng là chọn vào Combobox để hiện lên toàn bộ dữ liệu cũng như là hình ảnh của nhân viên:

Private Sub HoTen_Change()
    With NHAN_VIEN
        .Range("F3,H3,F4:H8").ClearContents
        If HoTen.Text = "" Then Exit Sub
        .[F3].Value = HoTen.Text
        .[H3].Value = HoTen.Column(1)
        .[F4].Value = HoTen.Column(2)
        .[F5].Value = HoTen.Column(6)
        .[F6].Value = HoTen.Column(4)
        .[F7].Value = HoTen.Column(3)
        .[F8].Value = HoTen.Column(5)
        Call PictInsert
    End With
End Sub

Với file này, tôi hy vọng đúng với ý của bạn.

Lưu ý, bạn đặt folder "Nhan Su" vào bất cứ ổ đĩa nào, nhưng nó phải chứa cái file này và folder chứa hình "HinhAnh" thì mới có thể hiện hình lên được.

 

[ndu96081631]

Private Sub PictInsert()
    On Error Resume Next
    Dim PicName As String, NoPict As String, Hinh As String
    NHAN_VIEN.Shapes("HoangTrongNghia").Delete
    PicName = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & HoTen.Column(1) & ".jpeg"
    NoPict = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & "NoPict.GIF"
    If FileExist(PicName) Then Hinh = PicName Else Hinh = NoPict
    With NHAN_VIEN.Pictures.Insert(Hinh)
        .Name = "HoangTrongNghia"
        .Top = NHAN_VIEN.[C4].Top: .Left = NHAN_VIEN.[C4].Left
        .Height = NHAN_VIEN.[C4:C7].Height: .Width = NHAN_VIEN.[C4].Width
    End With
End Sub

Nếu muốn code chạy chính xác trên Excel 2007 và Excel 2010 thì phải thêm LockAspectRatio = False vào (mục đích để hình được đặt chính xác vào cell)

 

[Hai Lúa Miền Tây]

Theo em thì em vẽ luôn cái Image vào rồi đặt thuộc tính PictureSizeMode nó là 1 là ok

Private Sub PictInsert()
    On Error Resume Next
    Dim PicName, NoPict As String', Hinh As String
    'NHAN_VIEN.Shapes("HoangTrongNghia").Delete
    PicName = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & HoTen.Column(1) & ".jpeg"
    NoPict = ThisWorkbook.Path & "\" & "HinhAnh" & "\" & "NoPict.GIF"
    If FileExist(PicName) Then NHAN_VIEN.Image1.Picture = LoadPicture(PicName) Else _
        NHAN_VIEN.Image1.Picture = LoadPicture(NoPict)
  '  With NHAN_VIEN.Pictures.Insert(Hinh)
  '      .Name = "HoangTrongNghia"
  '      .Top = NHAN_VIEN.[C4].Top: .Left = NHAN_VIEN.[C4].Left
  '      .Height = NHAN_VIEN.[C4:C7].Height: .Width = NHAN_VIEN.[C4].Width
  '  End With
End Sub