Nhờ trợ giúp làm thẻ học sinh từ cơ sở dữ liệu ảnh có sẳn

khaothibaclieu · 31/8/15

Nhờ các anh, chị giúp mình với. Mình có thư mục "ANH HOC SINH", File "IN THE HOC SINH", trong đó có Sheet "DS" và Sheet "TheHS".
Sheet DS có trường "TT" và trường "Họ và tên".
Ở Sheet "TheHS", nếu gõ vào số thứ tự nào (ô B2) thì hiện ra tên học sinh tương ứng ở ô F9 (Cái này thì quá dễ, mình tự làm được).
Mình nhờ mọi người giúp mình viết code từ tên học sinh ở ô F9, chèn hình tương ứng ở thư mục "ANH HOC SINH" vào ô trống quy định (ở đây mình đang dùng textbox, các bạn có thể chuyển sang loại nào cũng được). Dĩ nhiên là tên file ảnh học sinh và tên học sinh ở ô F9 phải giống nhau.
Xin gửi file đính kèm.
P/S: Vì hâm mộ các diễn viên hài này nên mạn phép tải ảnh về làm ví dụ. Mong các diễn viên và mọi người lượng thứ.

dhn46 · 31/8/15

Bạn tham khảo tiện ích in Form hàng loạt link tại chữ ký của tôi.

ndu96081631 · 31/8/15

khaothibaclieu đã viết:
Nhờ các anh, chị giúp mình với. Mình có thư mục "ANH HOC SINH", File "IN THE HOC SINH", trong đó có Sheet "DS" và Sheet "TheHS".
Sheet DS có trường "TT" và trường "Họ và tên".
Ở Sheet "TheHS", nếu gõ vào số thứ tự nào (ô B2) thì hiện ra tên học sinh tương ứng ở ô F9 (Cái này thì quá dễ, mình tự làm được).
Mình nhờ mọi người giúp mình viết code từ tên học sinh ở ô F9, chèn hình tương ứng ở thư mục "ANH HOC SINH" vào ô trống quy định (ở đây mình đang dùng textbox, các bạn có thể chuyển sang loại nào cũng được). Dĩ nhiên là tên file ảnh học sinh và tên học sinh ở ô F9 phải giống nhau.
Xin gửi file đính kèm.
P/S: Vì hâm mộ các diễn viên hài này nên mạn phép tải ảnh về làm ví dụ. Mong các diễn viên và mọi người lượng thứ.

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

khaothibaclieu · 1/9/15

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

Cảm ơn bạn rất nhiều. Code chạy rất tốt. Tâm trạng đang rất phấn khởi. Là lá la. @$@!^%

khaothibaclieu · 1/9/15

Nếu các bạn giúp được thì giúp mình luôn nhé. Thường thì mình sẽ yêu cầu các trường yêu cầu học sinh gửi file ảnh của từng học sinh. Nhưng học sinh vùng sâu vùng xa chụp được ảnh là quý rồi, khó mà yêu cầu các em nộp file hình. Mình muốn làm cách khác như sau:
Mình nhờ các trường dán ảnh theo mẫu như file đính kèm (Vì các đơn vị trường học không có máy scan, mình scan lại và lưu dưới dạng pdf). Xin hỏi có cách nào để trích ảnh hàng loạt, lưu mỗi file ảnh theo Họ và tên để dùng đoạn code ở trên in ảnh thẻ học sinh được không?
Hoặc các bạn có thể hướng dẫn mình cách nào khác tối ưu hơn. Mình xin cảm ơn lắm lắm!!! }}}}}

dangngocthuyen · 11/9/15

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

Sao em chèn rồi mà nó không hiện? nó báo lỗi NAME? $-\\/.$

khaothibaclieu · 25/11/15

Kính gửi thầy ndu96081631.
Nhờ thầy giúp em. Có một đơn vị gửi hình học sinh cho em. Khi xem thì ảnh học sinh luôn thẳng đứng nhưng khi đưa vào sheet thì ảnh luôn bị quay ngang. Em đã cố gắng quay hình học sinh như không có tác dụng. Mong thầy giúp em. Cám ơn thầy nhiều.
Em xin bổ sung ý thứ 2 luôn. Thực tế hiện nay là em đã áp dụng rất tốt ứng dụng này vào công việc. Nó giảm công việc dán hình thủ công vào thẻ rất nhiều, tiết kiệm được rất nhiều thời gian cho chúng em. Nhưng có thực tế là các đơn vị khi gửi hình và lập danh sách thì tên file hình và tên trong danh sách rất nhau. Ví dụ như bỏ sai dấu chữ THÚY hoặc THUý, hoặc tên file hình đánh máy dư khoảng trắng. Có cách nào giúp mình kiểm tra vào báo lỗi các tên trong danh sách và tên file hình không khớp nhau không? Cám ơn thầy rất nhiều.

ndu96081631 · 25/11/15

khaothibaclieu đã viết:
Kính gửi thầy ndu96081631.
Nhờ thầy giúp em. Có một đơn vị gửi hình học sinh cho em. Khi xem thì ảnh học sinh luôn thẳng đứng nhưng khi đưa vào sheet thì ảnh luôn bị quay ngang. Em đã cố gắng quay hình học sinh như không có tác dụng. Mong thầy giúp em. Cám ơn thầy nhiều.

Tôi xem ảnh trong cửa sổ Windows Explorer đã thấy ảnh nó quay ngang rồi mà.
Bạn nên chỉnh lại ảnh từ nguồn luôn (chứ không phải trong Excel). Chẳng hạn có thể dùng Windows Photo Viewer để làm việc này (rất đơn giản)

tieuthuvodanh1980 · 2/9/16

bạn xem thế này dùng tiện ko

cái vụ chèn hình thì bạn có 1 dshs có đường dẫn tới hình, rồi 1 phát là xong thôi, gõ từng cái 1 chi cho lâu
Cái của tôi sẽ tự động tính toán số thẻ trên 1 hàng và 1 trang để tiết kiệm giấy

be_09 · 2/9/16

tieuthuvodanh1980 đã viết:
bạn xem thế này dùng tiện ko
View attachment 164972
cái vụ chèn hình thì bạn có 1 dshs có đường dẫn tới hình, rồi 1 phát là xong thôi, gõ từng cái 1 chi cho lâu
Cái của tôi sẽ tự động tính toán số thẻ trên 1 hàng và 1 trang để tiết kiệm giấy

Đưa cái hình mà không đính kèm File ai biết bạn làm kiểu gì???

Với File của bạn, thì tôi sẽ làm như vầy:

- Tự động lấy tên File (của bất kỳ Folder nào), dựa vào tên File tự động gán nội dung vào các cột từ A2:F (sheet danh sách) và gán cho nó 1 cái Link.

- Sang sheet thẻ học sinh chọn 1 tên và xem kết quả (chứ chẳng cần chọn File nào cả).

be_09 · 2/9/16

tieuthuvodanh1980 đã viết:
bạn xem thế này dùng tiện ko

cái vụ chèn hình thì bạn có 1 dshs có đường dẫn tới hình, rồi 1 phát là xong thôi, gõ từng cái 1 chi cho lâu
Cái của tôi sẽ tự động tính toán số thẻ trên 1 hàng và 1 trang để tiết kiệm giấy

Diễn đàn là nơi trao đổi, giúp đỡ và chia sẽ.

Bạn chỉ đưa cái hình làm mẫu thì chẳng giúp ích gì cho chủ Topic và các thành viên khác, tôi tải File lên như nội dung tôi nêu ở bài 10.

Cách thực hiện:

- Bước 1: sheet Tao_Link, nhấn nút Tìm ổ dĩa và chọn thư mục

- Bước 2: nhấn nút [FONT=&amp]LấyLink[/FONT]

- Bước 3: nhấn vào biểu tượng [FONT=&amp]Lấy hình[/FONT]

- Bước 4: sang sheet TheHS vào D5 (sử dụng Validation) chọn 1 tên học sinh và xem kết quả (từ đây trở đi chọn tên học sinh nào thì nó sẽ lây hình học sinh đó vào).

Trong File có kết hợp hàm CommPic của ndu, nhưng có sửa lại 1 tý cho phù hợp với file này.

truckhoa2006 · 6/9/16

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

Bài tuy cũ nhưng giờ em mới áp dụng, thật là tuyệt vời. Cám ơn thầy rất nhiều.

Beemxike · 22/2/17

Cho mình hỏi ngu tý. Làm sao in hay chuyển PDF có hình dc. Mình áp dụng nhưng cần in ra nữa.

Emyeuexcel · 24/4/20

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

Thưa anh,

Em có file như đính kèm, em làm theo code anh hướng dẫn mà nó báo #Name, rất mong anh chỉ giúp!
Em cảm ơn nhiều lắm!

ndu96081631 · 24/4/20

Emyeuexcel đã viết:
Thưa anh,

Em có file như đính kèm, em làm theo code anh hướng dẫn mà nó báo #Name, rất mong anh chỉ giúp!
Em cảm ơn nhiều lắm!

Cho code vào 1 module nha bạn! Bạn đang cho code vào trong 1 sheet

Emyeuexcel · 24/4/20

ndu96081631 đã viết:
Cho code vào 1 module nha bạn! Bạn đang cho code vào trong 1 sheet

Anh ơi,

Em làm được file lúc nãy rồi! Rất mừng! Cảm ơn anh nhiều lắm lắm!
Nhưng sao cái file sau như tệp đính kèm thì nó ko được.
Anh chỉ giúp em với!
Mình để file excel chung với thư mục ảnh hay phải để excel bên ngoài vậy anh? Em để bên ngoài nó cũng ko ra.
Đa tạ anh chỉ dạy giúp em với ạ!

Bluestar092011 · 24/4/20

Emyeuexcel đã viết:
Anh ơi,

Em làm được file lúc nãy rồi! Rất mừng! Cảm ơn anh nhiều lắm lắm!
Nhưng sao cái file sau như tệp đính kèm thì nó ko được.
Anh chỉ giúp em với!
Mình để file excel chung với thư mục ảnh hay phải để excel bên ngoài vậy anh? Em để bên ngoài nó cũng ko ra.
Đa tạ anh chỉ dạy giúp em với ạ!

Cột E của bạn đang định dạng Text, bạn quét chọn vùng C10:C32, nhấn Ctrl + 1 và định dạng như hình.

Sửa công thức ô C10 như sau:

Mã:

=CommPic(B10 & ".jpg")

Copy công thức cho các cô phía dưới.

Emyeuexcel · 24/4/20

Bluestar092011 đã viết:
Cột E của bạn đang định dạng Text, bạn quét chọn vùng C10:C32, nhấn Ctrl + 1 và định dạng như hình.
View attachment 236405
Sửa công thức ô C10 như sau:

Mã:

=CommPic(B10 & ".jpg")

Copy công thức cho các cô phía dưới.

OK cảm ơn bạn! Mình cũng phát hiện ra và làm được rồi!

ngocha1114 · 12/6/20

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

hi anh. bài viết của anh quả thực rất hữu ích cho em. Nhưng vấn đề là khi in thì ảnh lại k hiện theo file ạ. Anh giúp em với,. cảm ơn anh nhiều nhiều

Bài đã được tự động gộp: 12/6/20

ngocha1114 đã viết:
hi anh. bài viết của anh quả thực rất hữu ích cho em. Nhưng vấn đề là khi in thì ảnh lại k hiện theo file ạ. Anh giúp em với,. cảm ơn anh nhiều nhiều

à ok anh. em đã in được cả ảnh rồi ạ. hihi

openhoang · 11/9/20

ndu96081631 đã viết:

Chèn code dưới đây vào 1 Module:

Mã:

Function CommPic(ByVal Pic As String, Optional ByVal Cel As Range) As String
  Dim mRng As Range, comm As Comment
  On Error Resume Next
  Application.Volatile
  If Cel Is Nothing Then Set Cel = Application.ThisCell
  Cel(1, 1).Comment.Delete
  If Not CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    Pic = ThisWorkbook.Path & "\" & Pic
  End If
  If CreateObject("Scripting.FileSystemObject").FileExists(Pic) Then
    If Cel(1, 1).Comment Is Nothing Then Cel(1, 1).AddComment
    Cel(1, 1).Comment.Text vbLf
    Set mRng = Cel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = Cel(1, 1)
    Set comm = mRng(1, 1).Comment
    comm.Visible = True
    With comm.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.Visible = msoFalse
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .Fill.UserPicture Pic
    End With
  End If
End Function

Tại 1 cell nào đó trên bảng tính (hoặc trộn nhiều cell lại cho bằng với khung hình), bạn gõ công thức:

Mã:

=CommPic("ANH HOC SINH\"&F9&".jpg")

Xong!
----------------
Tức là:
- Chèn hình trực tiếp lên cell chứ không thông qua TextBox (xóa cái textbox của bạn đi)
- Lưu file thành đuôi XLSM nhé

Bác ơi cho e hỏi em đã áp dụng code của bác vào file excel và đã lấy được hình nhưng khi xem ở chế độ trước khi in thì không thấy hình hiện lên
bác cho mình hỏi có cách nào khắc phục được không?

Nhờ trợ giúp làm thẻ học sinh từ cơ sở dữ liệu ảnh có sẳn

Thành viên hoạt động

File đính kèm

Hướng tới tương lai

Huyền thoại GPE

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

Thành viên thường trực

Thành viên hoạt động

File đính kèm

Huyền thoại GPE

Thành viên mới

Biên Hòa, Đồng Nai

Biên Hòa, Đồng Nai

File đính kèm

Thành viên hoạt động

Thành viên mới

Thành viên thường trực

File đính kèm

Huyền thoại GPE

Thành viên thường trực

File đính kèm

Thành viên hoạt động

Thành viên thường trực

Thành viên mới

Thành viên mới

Facebook

Group