Chèn ảnh vào textbox (2 người xem)

[italy891]

Giúp em với !
E có 1 ảnh nhân viên ở trong ổ D . E tạo 1 text box ảnh và 1 text box mã nhân viên . em muốn nhập mã nhân viên vào text box thì sẽ có ảnh ra .

Các bác xem file đính kèm !

E tham khảo code này nhưng chưa biết chỉnh ntn
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPic
On Error Resume Next
If Target.Address = "$E$8" Then
strPic = Target.Parent.Range("K4").Value
With Sheet1.Shapes("PicFrame").Fill
If strPic <> 0 Then
.UserPicture CStr(strPic)
Else
.Solid: .ForeColor.SchemeColor = 12
End If
End With
End If
End Sub

 

[italy891]

Mình tham khảo ở đây !
http://www.giaiphapexcel.com/forum/...a-ảnh-hiện-vào-khung-(TextBox)-bằng-VBA/page2

 

[italy891]

có ai giúp mình với !

 

[phucbugis]

Giúp em với !
E có 1 ảnh nhân viên ở trong ổ D . E tạo 1 text box ảnh và 1 text box mã nhân viên . em muốn nhập mã nhân viên vào text box thì sẽ có ảnh ra .

Các bác xem file đính kèm !
...

# bạn nói chưa được rõ, ảnh phải đặt trong 1 thư mục nào đó thuộc ổ D mới chính xác ...

# bạn tải file về xem sao nhé:
- tạo 1 thư mục anhCNV nằm trong ổ D, bên trong thư mục tạo 1 số ảnh bất kỳ có đuôi là .bmp (bạn có thể thay đổi tên đuôi trong code )
- thông tin liên quan đến mã CNV --> khai báo tại vùng K4:M10.
- đã thay thế Shape nhập mã thành Textbox1 (activeX controls) thì hợp lý hơn.

Sub GPE_XemAnhCNV()
Dim strPath As String
Dim ws As Worksheet, maxCNV As Variant
Dim TypeOfFile As String, sFile As String
Dim Sh As Shape
    
    strPath = "D:\anhCNV\"
    Set ws = ThisWorkbook.Sheets("Sheet1")
    maxCNV = ws.OLEObjects("TextBox1").Object.Value
    TypeOfFile = ".bmp"
    sFile = strPath & maxCNV & TypeOfFile
    
    Set Sh = ws.Shapes("Rectangle 4")
    
    If Dir(sFile) <> "" Then
        Sh.Fill.UserPicture sFile
        Sh.TextFrame.Characters.Text = ""
        Call TimThongTin(ws, maxCNV, True)
    Else
        Sh.Fill.Solid 'xoa' anh?
        Sh.TextFrame.Characters.Text = "?"
        Call TimThongTin(ws, maxCNV, False)
    End If
    
End Sub


Sub TimThongTin(iSheet As Worksheet, iMax As Variant, dkien As Boolean)
Dim vung As Range, Ten As String, Chucvu As String

    Set vung = iSheet.Range("K4:M10")
    '--------
    If dkien = True Then
        Ten = WorksheetFunction.VLookup(iMax, vung, 2, 0)
        Chucvu = WorksheetFunction.VLookup(iMax, vung, 3, 0)
    Else
        Ten = "?"
        Chucvu = "?"
    End If
    '--------
    iSheet.Shapes("Rectangle_HovaTen").TextFrame.Characters.Text = Ten
    iSheet.Shapes("Rectangle_Chucvu").TextFrame.Characters.Text = Chucvu
    
    Set vung = Nothing
End Sub