Gõ tên người cho ra hình ảnh (1 người xem)

[vutienhp]

Nhân đọc bài viết " Chèn hình vào cell bằng hàm tự tạo" mình nhớ tới 1 vấn đề mình đang rất quan tâm. Đó là làm thế nào để gõ tên 1 người nào đó để hiện ra ảnh của họ. Mình có file đính kèm( DS của mình chỉ có 5 người- ảnh minh hoạ). Bạn nào biết xin chỉ giúp mình!
Mình xin cảm ơn!

 

[leonguyenz]

Sử dụng code của thầy Anh Tuấn, mình có thêm cột 26 Pic name (tên file hình) bên dữ liệu và sửa lại 1 chút name List.

 

[Lê Duy Thương]

Nhân đọc bài viết " Chèn hình vào cell bằng hàm tự tạo" mình nhớ tới 1 vấn đề mình đang rất quan tâm. Đó là làm thế nào để gõ tên 1 người nào đó để hiện ra ảnh của họ. Mình có file đính kèm( DS của mình chỉ có 5 người- ảnh minh hoạ). Bạn nào biết xin chỉ giúp mình!
Mình xin cảm ơn!

BẠN XEM THỬ CODE CỦA (NDU GPE) TÔI CHẾ LẠI MỘT CHÚT

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, PicName As String, Clls As Range
  On Error Resume Next
  If Target.Address - "$A$1" Then
    Application.ScreenUpdating = False
    For Each Clls In Sheet4.[A2:A600].SpecialCells(3)
      Set Rng = Sheet2.Range("A2").CurrentRegion
      PicName = ThisWorkbook.Path & "\" & Rng.Resize(, 1).Find(Clls.Value).Offset(, 4)
      Sheet4.Shapes(Clls.Offset(6, 1).Address).Delete
      With Sheet4.Pictures.Insert(PicName)
        .ShapeRange.LockAspectRatio = msoFalse
        .Name = Clls.Offset(6, 1).Address
        .Left = Clls.Offset(6, 1).Left: .Top = Clls.Offset(6, 1).Top
        .Width = Clls.Offset(6, 1).MergeArea.Width: .Height = Clls.Offset(6, 1).MergeArea.Height
      End With
    Next
    Application.ScreenUpdating = True
  End If
End Sub

XEM THÊM FILE

 

[Hoàng Trọng Nghĩa]

Còn 1 cách này nữa nè bạn:

Trước hết phải tạo một Hàm kiểm tra File hình có tồn tại không:

Private Function FileTonTai(DuongDan_TenFile) As Boolean
  Dim F As String
  F = Dir(DuongDan_TenFile)
  If F <> "" Then FileTonTai = True Else FileTonTai = False
End Function

Sau đó mới thực hiện sự kiện Worksheet_Change:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Dim Shape As Object, PicName As String
  If Target.Address = "$AC$8" Then
    PicName = ThisWorkbook.Path & "\" & "CBCNV" & "\" & [AC10].Value & ".JPG"
    For Each Shape In TraTim.Shapes
      If Left(Shape.Name, 3) = "ANH" Then
        Shape.Delete
      End If
    Next
    If FileTonTai(PicName) = True Then
      With TraTim.Pictures.Insert(PicName)
        .Name = "ANH"
        .Left = [B7].Left: .Top = [B7].Top
        .Width = [B7].Width: .Height = [B7:B15].Height
      End With
    End If
  End If
End Sub

Bạn nên làm thêm 1 cột Mã hình ảnh nữa nhé! Sau đó mã nào thì đặt tên hình như vậy là OK.

Lưu ý là giải nén trước rồi mở File nhé!

 

[ndu96081631]

Còn 1 cách này nữa nè bạn:

Trước hết phải tạo một Hàm kiểm tra File hình có tồn tại không:

Private Function FileTonTai(DuongDan_TenFile) As Boolean
  Dim F As String
  F = Dir(DuongDan_TenFile)
  If F <> "" Then FileTonTai = True Else FileTonTai = False
End Function

Sau đó mới thực hiện sự kiện Worksheet_Change:

Kiểm tra file tồn tại mà dùng hàm Dir cũng như không

 

[Hoàng Trọng Nghĩa]

Kiểm tra file tồn tại mà dùng hàm Dir cũng như không

Em chỉ biết vậy, Thầy hướng dẫn cho em cách khác đi ạ.

 

[ndu96081631]

Em chỉ biết vậy, Thầy hướng dẫn cho em cách khác đi ạ.

Chuyên gia xử lý file, folder là Scripting.FileSystemObject
Trường hợp tên hoặc đường dẫn là tiếng Việt có dấu thì hàm Dir... tèo

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

 

[vutienhp]

Xin cảm ơn sự giúp đỡ của thầy ndu cũng như tất cả các bạn đã quan tâm và tháo gỡ vướng mắc cho tôi trong vấn đề này!
Kính chúc thầy ndu, chúc các bạn và gia đình luôn dồi dào sức khoẻ và thành công!