Giúp chỉnh sửa code

[tommybull]

Mình tìm thấy file này trên mạng gpe thấy rất hữu ích cho công việc của mình, nhưng mình muốn thay đổi lại cách tìm kiếm, thay vì tìm kiếm nhân viên ở cột "a" (stt) thì mình muốn tìm kiếm nhân viên ở cột "c" (mã số nhân viên)
các bạn vui lòng giúp mình chỉnh sửa lại code hoặc cấu trúc "define name" sao cho hình ảnh chạy chính xác nhé
xin trân trọng cảm ơn

happy new year to gpe

 

[kyo]

File này là file nào vậy bạn? Mình down file bạn về chỉ thấy ảnh nhưng không thấy file bạn muốn nhờ giúp?

 

[tommybull]

giúp sửa code file excell

Mình tìm thấy file này trên mạng gpe thấy rất hữu ích cho công việc của mình, nhưng mình muốn thay đổi lại cách tìm kiếm, thay vì tìm kiếm nhân viên ở cột "a" (stt) thì mình muốn tìm kiếm nhân viên ở cột "c" (mã số nhân viên)
các bạn vui lòng giúp mình chỉnh sửa lại code hoặc cấu trúc "define name" sao cho hình ảnh chạy chính xác nhé
xin trân trọng cảm ơn

happy new year to gpe

Mình add lại file đính kèm nha!

 

[ndu96081631]

Mình add lại file đính kèm nha!

- Đầu tiên sửa tham chiếu Data Validation tại cell AF3 thành: =CMND
- Sửa code thành:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArray, fld As String
  On Error Resume Next
  fld = ThisWorkbook.Path & "\Pic\"
  If Target.Address = "$AF$3" Then
    With Sheets("TRICHLUC").Image1
      .Picture = Nothing
      .Picture = [COLOR=#ff0000][B]LoadPicture(fld & Target.Value & ".jpg")[/B][/COLOR]
      .PictureSizeMode = 1
    End With
  End If
End Sub

Dòng màu đỏ là chổ vừa sửa lại

 

[ThuNghi]

Mình add lại file đính kèm nha!

Thay code này vào nhé.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArray, Fld$, sID$, sFile$, i&
  On Error Resume Next
  Fld = ThisWorkbook.Path & "\Pic\"
  sArray = Sheets("DATA").Range("DS").Value
  If Target.Address = "$AF$3" Then
    sID = Target.Value
    For i = 1 To UBound(sArray)
      If sArray(i, 3) = sID Then
        sFile = sArray(i, 6)
        With Sheets("TRICHLUC").Image1
          .Picture = Nothing
          .Picture = LoadPicture(Fld & sFile & ".jpg")
          .PictureSizeMode = 1
        End With
        Exit For
      End If
    Next i
  End If
End Sub

Lý do: lúc trước bạn lấy tên file ảnh từ cột 1 (stt) của
sArray = Sheets("DATA").Range("DS").Value
Vậy nay muốn thay lấy từ mã thì phải duyệt qua SArray.

 

[tommybull]

Morning! ThuNghi
Giúp mình kiểm tra lại hàm Vlookup với, thông tin nhân viên không hiển thị được

Tks!!
Have a nice day!

 

[ChanhTQ@]

. . . . . . . .

[ QUOTE370528]Morning! ThuNghi Giúp mình kiểm tra lại hàm Vlookup với, thông tin nhân viên không hiển thị được Tks!!

Have a nice day!
​

[/QUOTE]

​

 

[tommybull]

Giúp chỉnh sửa code & công thức

hôm qua bạn giúp mình chỉnh lai đoạn code để hiển thị hình ảnh nhân viên rồi, nhưng mình không thể thể hiện thông tin cá nhân của nhân viên vào form
Làm ơn giúp mình kiểm tra lại hàm vlookup xem như thế nào nhé

Xin chân thành cảm ơn

 

[ndu96081631]

Morning! ThuNghi
Giúp mình kiểm tra lại hàm Vlookup với, thông tin nhân viên không hiển thị được

Tks!!
Have a nice day!

Lúc trước bạn lấy STT làm ID tìm kiếm nên dùng hàm VLOOKUP (vì STT nằm ở cột đầu tiên)...
Giờ bạn dùng số Mã nhân viên làm ID, mà cột Mã này lại nằm ở giữa, vậy sao mà dùng VLOOKUP được chứ ---> Phải dùng INDEX + MATCH
thêm nữa: Đã dùng VBA code để hiển thị hình ảnh, ta có thể nhân cơ hội ấy điền các thông tin còn lại bằng code luôn
Sửa lại code thế này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fld As String, fRng As Range
  On Error Resume Next
  fld = ThisWorkbook.Path & "\Pic\"
  If Target.Address = "$AF$3" Then
    Range("Q8:X14").ClearContents
    Set fRng = Sheets("DATA").Range("DS").Find(Target.Value, , xlValues, xlWhole)
    If fRng.Value <> "" Then
      If Not fRng Is Nothing Then
        With Me.Image1
          .Picture = Nothing
          .Picture = LoadPicture(fld & fRng(, 4) & ".jpg")
          .PictureSizeMode = 1
        End With
        Range("Q8") = fRng(, -1)
        Range("Q10") = fRng(, 2)
        Range("Q12") = fRng(, 3)
        Range("Q14") = fRng(, 4)
      End If
    End If
  End If
End Sub

Khỏi hàm gì cả, code tự điền thông tin luôn

 

[ThuNghi]

hôm qua bạn giúp mình chỉnh lai đoạn code để hiển thị hình ảnh nhân viên rồi, nhưng mình không thể thể hiện thông tin cá nhân của nhân viên vào form
Làm ơn giúp mình kiểm tra lại hàm vlookup xem như thế nào nhé

Xin chân thành cảm ơn

Bổ sung thêm các dòng lấy tên, cmnd ... từ sArray
Code như sau

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArray, Fld$, sID$, sFile$, i&
  On Error Resume Next
  Fld = ThisWorkbook.Path & "\Pic\"
  sArray = Sheets("DATA").Range("DS").Value
  If Target.Address = "$AF$3" Then
    sID = Target.Value
    For i = 1 To UBound(sArray)
      If sArray(i, 3) = sID Then
        sFile = sArray(i, 6)
        With Sheets("TRICHLUC")
          With .Image1
            .Picture = Nothing
            .Picture = LoadPicture(Fld & sFile & ".jpg")
            .PictureSizeMode = 1
          End With
          .[Q8] = sArray(i, 2) 'Ten
          .[Q10] = sArray(i, 4) 'NgaySinh
          .[Q12] = sArray(i, 5) 'DonVi
          .[Q14] = CStr(sArray(i, 6)) 'SoCM
        End With
        Exit For
      End If
    Next i
  End If
End Sub

 

[Hoàng Trọng Nghĩa]

hôm qua bạn giúp mình chỉnh lai đoạn code để hiển thị hình ảnh nhân viên rồi, nhưng mình không thể thể hiện thông tin cá nhân của nhân viên vào form
Làm ơn giúp mình kiểm tra lại hàm vlookup xem như thế nào nhé

Xin chân thành cảm ơn

Trước hết, nếu bạn vẫn muốn giữ mã số thẻ, thì việc đầu tiên, bạn sửa tên hình lại là mã số thẻ.
Sau đó, bạn chép code dưới đây vào thì sẽ show tất cả hình ảnh lẫn thông tin của mã số đó.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fld As String, MyID As Range
  On Error Resume Next
  fld = ThisWorkbook.Path & "\Pic\"
  If Target.Address = "$AF$3" Then
    Application.ScreenUpdating = False
    With Sheets("TRICHLUC").Image1
      .Picture = Nothing
      .Picture = LoadPicture(fld & Target.Value & ".jpg")
      .PictureSizeMode = 1
    End With
    Range("Q8:X14").ClearContents
    Set MyID = Sheets("DATA").Range("C2:C5").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    With Range("Q8")
        .Value = MyID.Offset(, -1)
        .Offset(2) = MyID.Offset(, 1)
        .Offset(4) = MyID.Offset(, 2)
        .Offset(6) = MyID.Offset(, 3)
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[ndu96081631]

Bổ sung thêm các dòng lấy tên, cmnd ... từ sArray

ThuNghi bị "tẩu hỏa nhập ma" với mấy cái xử lý Array rồi
Mấy cái PicForm này thường chỉ lấy 1 vài thông tin thôi và cũng chỉ lấy đúng 1 record đầu tiên tìm thấy, vậy đâu cần đến cái dao mổ trâu chứ
Ẹc... Ẹc...
------------------------

Trước hết, nếu bạn vẫn muốn giữ mã số thẻ, thì việc đầu tiên, bạn sửa tên hình lại là mã số thẻ.
Sau đó, bạn chép code dưới đây vào thì sẽ show tất cả hình ảnh lẫn thông tin của mã số đó.

Cũng đâu cần phải đổi tên hình chứ ---> Find method tìm được rồi, cứ thế "chiếu" sang mà lấy tên hình thôi

 

[Hoàng Trọng Nghĩa]

Cũng đâu cần phải đổi tên hình chứ ---> Find method tìm được rồi, cứ thế "chiếu" sang mà lấy tên hình thôi

Uh ha, đúng là thầy cao kiến!

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fld As String, MyID As Range
    On Error Resume Next
    fld = ThisWorkbook.Path & "\Pic\"
    If Target.Address = "$AF$3" Then
        Application.ScreenUpdating = False
        Set MyID = Sheets("DATA").Range("C2:C5").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        With Sheets("TRICHLUC").Image1
            .Picture = Nothing
            .Picture = LoadPicture(fld & MyID.Offset(, 3).Value & ".jpg")
            .PictureSizeMode = 1
        End With
        Range("Q8:X14").ClearContents
        With Range("Q8")
            .Value = MyID.Offset(, -1)
            .Offset(2) = MyID.Offset(, 1)
            .Offset(4) = MyID.Offset(, 2)
            .Offset(6) = MyID.Offset(, 3)
        End With
        Application.ScreenUpdating = True
    End If
End Sub