Góp ý cho bạn:
Hiện tại mình đã đặt tên hình theo số hồ sơ. và cũng dùng số hồ sơ để tra. Chỉ mắc tại phần sử dụng VBA, phần này thì mình chưa biết làm. Bạn nào biết chỉ giúp mình với. Mình cảm ơn
Trong File của bạn tại E4 đang dựa vào ID/Mã NV để tra.
Sorry mình nhầm. Nhưng bên mình hay sử dụng mã nhân viên hơn là số hồ sơ, mã nhân viên thì mọi người nhớ hơn là số hồ sơ, nên khi tra mình sẽ chỉ tra mã nhân viên thôi. Và ảnh mình cũng lưu theo mã nhân viên rồi, nên việc sử dụng mã nhân viên hay mã số hồ sơ không quan trọng. Quan trọng là phần VBA thôi
Thêm sheet danh mục vừa có số hồ sơ, mã nhân viên họ và tên hoặc bộ phận thì muốn tra cái gì mà không được chỉ việc chọn 1 trong các loại đó thì được kết quả.
ok. mình hiểu. nhưng cái mình cần giúp là phần ảnh kia thôi.
Tôi biết làm thế nào để tra cho thuận tiện, còn giúp thì chờ các thành viên khác vậy.
Các bước:
Private Sub Worksheet_Change(ByVal Target As range)
If Target.Address = "$E$4" Then
InsertPicture ThisWorkbook.Path & "\Anh\" & Target.Value & ".jpg", ThisWorkbook.Worksheets("Trend").range("B2:B5")
End If
End SubPrivate Sub Worksheet_Change(ByVal Target As range)
If Target.Address = "$E$4" Then
InsertPicture ThisWorkbook.Path & "\Anh\" & Target.Value & ".jpg", ThisWorkbook.Worksheets("Trend").range("B2:B5"), , True
End If
End SubSub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
Optional original As Boolean = False, Optional center As Boolean = False, _
Optional LinkToFile As Boolean = False)
' Target: vung nhap anh. Co the la nhieu cell
' Neu Target = Nothing thi Target = ActiveCell
' Neu original = True thi nhap anh kich thuoc thuc.
' Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
' nguoc lai thi se vua khit vung Target
' LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co
Dim w As Double, h As Double, shp As Shape, fso As Object
If Target Is Nothing Then Set Target = ActiveCell
On Error Resume Next
Target.Parent.Shapes(Target.Address).Delete
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(PicFilename) Then
If LinkToFile Then
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoTrue, msoFalse, Target.left, Target.top, 0, 0)
Else
Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
End If
If Not shp Is Nothing Then
With shp
If original Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
ElseIf center Then
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
w = Target.Width
h = w * .Height / .Width
If h > Target.Height Then
h = Target.Height
w = h * .Width / .Height
End If
.left = Target.left + (Target.Width - w) / 2
.top = Target.top + (Target.Height - h) / 2
.Width = w
.Height = h
Else
.Width = Target.Width
.Height = Target.Height
End If
shp.Name = Target.Address
shp.Placement = xlMoveAndSize
End With
End If
End If
Set fso = Nothing
End Sub
Chị thử xem
Cảm ơn
Mình đã làm đc. Cảm ơn bạn rất nhiều.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Then
On Error Resume Next
With Sheet4
.Shapes("anh").Delete
.Shapes.AddPicture(ThisWorkbook.Path & "\Anh\" & .Range("E4").Value & ".JPG", msoFalse, msoTrue, .Range("B2").Left, .Range("B2").Top, .Range("B2").Width, .Range("B2:B5").Height).Name = "anh"
End With
End If
End Sub
