Trợ giúp về hàm auto insert picture (1 người xem)

chiphoi3 · 29/9/09

Chào tất cả mọi người,

Mình mới tham gia diễn đàn GPE, vấn đề của mình liên quan đến việc tự động insert hình ảnh cá nhân của nhân sự trong công ty. Mình đã dùng chức năng search của diễn dàn và thấy có 1 số topic cũng liên quan đến vấn đề này nhưng chưa hoàn thiện, nay mình xin mở topic nhờ các anh chị có kinh nghiệm trợ giúp.

Các topic liên quan:

http://www.giaiphapexcel.com/forum/showthread.php?t=25440
http://www.giaiphapexcel.com/forum/showthread.php?p=131046
http://www.giaiphapexcel.com/forum/showthread.php?t=4669

Mình tổng hợp lại vấn đề như sau:
- Chức năng insert picture sẽ được tự động dựa trên đường dẫn có sẵn
- Nếu thay đổi đường dẫn thì hình cũ sẽ được xóa đi, và hình mới sẽ được cập nhật
- Có thể dùng chức năng Fill handle (giống như fill down khi dùng chuột kéo xuống như trong hình). Vấn đề này mình chưa thấy đoạn mã nào trong GPE giải quyết được nếu như dữ liệu khá nhiều (bị duplicate hình), ko thể manual insert ID cho từng cell được. Đây cũng chính là vấn đề lớn nhất của mình

- Vị trí của hình khi insert linh động (trong ví dụ của mình thì mình muốn nó gắn vào column C)
- Hình ở vị trí center của cell (đối với cell quá lớn mà hình quá nhỏ)
hoặc tự động resize hình theo kích thước mặc định của cell
- Đường dẫn thư mục hình ảnh linh hoạt (không nhất thiết phải nằm cùng 1 thư mục với file excel)
- Sau khi insert hình thì có thể xóa đường dẫn đi mà ko bị mất hình
- Hình ảnh được attach thẳng vào file excel và có thể share cho người khác mà ko cần các file hình ảnh đi kèm (vì file hình ảnh nằm rải rác các folder khác nhau như ví dụ hình trên)

Mình cũng có search google hy vọng kiếm 1 cái function dạng user-defined giải quyết vấn đề này nhưng vẫn chưa tìm ra.
Mình đính kèm file data mẫu, hy vọng các cao thủ của GPE giúp mình.
Thân.

siwtom · 22/6/14

vuongtoituonglai đã viết:
Cảm ơn bạn nhé, hình của mình có khi đuôi .jpg hoặc bmp có công thức nào phù hợp với cả 2 đuôi hình này không bạn. file hình của mình do một bộ phận khác cung cấp khi họ dùng đuôi này lúc thì họ dùng đuôi kia. mình đang bối rối quá.

Thì bạn nhập hoặc

Mã:

=InsertPic(C27&".bmp")

hoặc

Mã:

=InsertPic(C27&".jpg")

Còn nếu ý bạn là một số ảnh chỉ có JPG và một số khác chỉ có BMP mà trong công thức cho cell bạn không biết rõ sẽ có ảnh JPG hay BMP thì cho riêng nhu cầu của mình bạn có thể sửa thành

Mã:

Function InsertPic(ByVal picname As String) As String
Dim fullName As String, pic As Shape, cell_ As range, fs As Object
    Set cell_ = Application.ThisCell
    On Error Resume Next
    cell_.Parent.Shapes(cell_.Address).Delete
    If Err.Number Then Err.Clear
    On Error GoTo 0
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(ThisWorkbook.Path & "\" & picname & ".jpg") Then
        fullName = picname & ".jpg"
    [COLOR=#ff0000]ElseIf[/COLOR] fs.FileExists(ThisWorkbook.Path & "\" & picname & ".bmp") Then
        fullName = picname & ".bmp"
    End If
    If fullName <> "" Then
        Set pic = cell_.Parent.Shapes.AddPicture(ThisWorkbook.Path & "\" & fullName, _
            msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height)
        pic.LockAspectRatio = msoTrue
        pic.Name = cell_.Address
    End If
    Set cell_ = Nothing
    Set fs = Nothing
End Function

Nếu có thêm nhiều định dạng vd. GIF, PNG thì thêm ElseIf ... hoặc thêm tham số dạng "jpg,bmp,gif,png" để code tự kiểm tra lần lượt xem ảnh nào có trên đĩa

Công thức

Mã:

=InsertPic(C27)

hoặc

Mã:

="Đây là hoa hậu lớp 10A"&InsertPic(C27)

vuongtoituonglai · 23/6/14

Cảm ơn bạn Siwtom nhé. trong phần công thức bạn có để="đây là hoa hậu lớp 10A" ý nghĩa của cụm từ này là gì vậy bạn.

siwtom · 23/6/14

vuongtoituonglai đã viết:
Cảm ơn bạn Siwtom nhé. trong phần công thức bạn có để="đây là hoa hậu lớp 10A" ý nghĩa của cụm từ này là gì vậy bạn.

Ý nghĩa của nó là: không bắt buộc phải là =InsertPic(C27) mà có thể là ="chuỗi bất kỳ mà tôi thích" & InsertPic(C27) hoặc =(B5^2+B10)*SIN(A2) &InsertPic(C27)

Tóm lại có thể là biểu thức bất kỳ nhưng phải có tính hàm InsertPic để Excel thực hiện code của hàm đó. Thế thôi.

tobuvn · 23/6/14

Chú @sealand và các pro ơi, khi in thẻ ra nó bị nhòe hơn là cháu làm thủ công chú ạ. Kết quả máy quét không quét mã vạch được. Chú có cách nào để nó tăng được độ nét lên không ạ?
Khi cháu copy cả 2 loại mã vạch .jpg và .png ra word ở các kích thước khác nhau đều quét được dễ dàng ạ.

sealand · 23/6/14

Mình test rồi, kể cả insert picture đều không thấy có độ nét cao hơn. Muốn có độ nét cao hơn thì bạn phải hiển thị mã vạch với độ nét cao nhất và khi chụp lưu ảnh với hình lớn hơn.
Tóm lại là mình không ủng hộ cách làm này mà thể hiện trực tiếp bằng font Barcode mới nét được. Lúc đó chỉ còn phụ thuộc vào máy in của bạn mà thôi.

tobuvn · 23/6/14

Cháu tạo mã vạch tại trang http://tools.sinhvienit.net/barcode/
Sau đó dùng paint Save as sang .jpg và để file đó cùng thư mục với file excel nguồn. Kích thước ảnh trong thẻ cháu cũng thay đổi kích thước và in ra. Nhưng khi cháu dán lên word in ra thì vã vạch nét hơn rõ ràng, còn trong cách chèn tự động nó bị hơi nhòe nên không quét được ạ. Chú cứ in test thử xem ạ! Cháu cảm ơn chú!

sealand · 24/6/14

Tại sao cứ phải nhờ người ta ít nhất mất phí Internet mà không tải font Barcode về máy, rồi tại ô A1 chẳng hạn em gõ Mã học sinh vào đó rồi Format font là Barcode xem nào.Chắc chắn chả có cái ảnh nào ăn đứt được độ nét.
Minhf là dân kế toán in báo cáo thuế, nếu in trực tiếp từ phần mềm bảo đảm nét hơn lưu thành file *.PDF rồi in.

tobuvn · 24/6/14

Thật tuyệt vời! Thực sự cháu không ngờ lại có các phần mềm hỗ trợ đó. Cảm ơn chú nhiều! /-*+/

sealand · 25/6/14

Lại sai rồi, chẳng phải phần mềm chi ráo. Nó chỉ là 1 Font để hiển thị các ký tự dưới dạng mã vạch mà thôi. Vậy nên nó cũng chẳng chạy gì trên máy của bạn cả.

tobuvn · 25/6/14

Vâng, cháu đọc không kĩ vì phần mềm quản lý bán hàng của cháu có phbararbarrcode nên cháu không để ý từ font chú để ở trước ạ. Cháu cảm ơn chú ạ! %#^#$

tobuvn · 26/6/14

Cháu download file code128 về và để mã học sinh thành font code128 và nó biến thành mã vạch nhưng máy vẫn ko đọc được ạ. @!##

anhdepjai · 27/6/14

Bạn thử cách sau nhé: thêm dấu * vào đầu và cuối nội dung trong đoạn barcode. Ví dụ: đoạn văn bản ở dạng barcode là " abcd " thì bạn thêm dấu "*" sẽ thành " *abcd* "

sealand · 27/6/14

Em xem lại xem sao: Trên trang em đã làm Barcode mặc định là code 39, trong khi em tải font code128
Tốt nhất em kiểm tra đầu quét của mình hỗ trợ đọc được font nào thì hãy tải font đó về dùng nha

sealand · 27/6/14

Thôi thì anh giúp em thực hiện theo cách quen làm xem sao nha. Chắc chắn Barcode sẽ nét

1/Chép mã cần tạo Barcode vào trang em quen làm và tạo Barcode
2/Nhấn chuột phải lên hình kết quả: Em không Save Image as... mà em chọn Copy Image
3/Mở Sheet2 lên và Paste vào đó. Ta được 1 Picture có tên gì đó. Em chọn nó và đổi tên thành Mã HS mà em đã tạo Bar code.
Như vậy thay vì em lưu ảnh bằng file em lưu luôn trong Sheet2. Để giảm dung lượng em co ảnh lại bé nhất có thể.

4/Em sửa Code như file anh gửi. Bảo đảm nét như "SONY"

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$L$25" Then
Application.ScreenUpdating = False
Sheet1.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
InsBarcode Target
Target.Select
End If
End Sub
'--------------------------------------
Sub InsBarcode(ByVal mName As String)
Dim Sh As Shape, mSave As String
For Each Sh In Sheet1.Shapes
mSave = mSave & Sh.Name & ";"
Next
Sheet1.Shapes("Barcode").Delete
Sheet2.Shapes(mName).Copy
    Sheets("Sheet1").[C34].Select
    ActiveSheet.Paste
For Each Sh In Sheet1.Shapes

If InStr(1, mSave, Sh.Name) = 0 Then
Sh.Name = "Barcode"
Sh.Top = Sheet1.[C20].Top
Sh.Left = Sheet1.[C20].Left
Sh.Height = 22
Sh.Width = 95
End If
Next
End Sub

tobuvn · 30/6/14

Vâng, cháu cảm ơn chú nhiều ạ!

vuongtoituonglai · 5/7/14

siwtom đã viết:
Thì bạn nhập hoặc

Mã:

=InsertPic(C27&".bmp")

hoặc

Mã:

=InsertPic(C27&".jpg")

Còn nếu ý bạn là một số ảnh chỉ có JPG và một số khác chỉ có BMP mà trong công thức cho cell bạn không biết rõ sẽ có ảnh JPG hay BMP thì cho riêng nhu cầu của mình bạn có thể sửa thành

Mã:

Function InsertPic(ByVal picname As String) As String Dim fullName As String, pic As Shape, cell_ As range, fs As Object Set cell_ = Application.ThisCell On Error Resume Next cell_.Parent.Shapes(cell_.Address).Delete If Err.Number Then Err.Clear On Error GoTo 0 Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(ThisWorkbook.Path & "\" & picname & ".jpg") Then fullName = picname & ".jpg" [COLOR=#ff0000]ElseIf[/COLOR] fs.FileExists(ThisWorkbook.Path & "\" & picname & ".bmp") Then fullName = picname & ".bmp" End If If fullName <> "" Then Set pic = cell_.Parent.Shapes.AddPicture(ThisWorkbook.Path & "\" & fullName, _ msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height) pic.LockAspectRatio = msoTrue pic.Name = cell_.Address End If Set cell_ = Nothing Set fs = Nothing End Function

Nếu có thêm nhiều định dạng vd. GIF, PNG thì thêm ElseIf ... hoặc thêm tham số dạng "jpg,bmp,gif,png" để code tự kiểm tra lần lượt xem ảnh nào có trên đĩa

Công thức

Mã:

=InsertPic(C27)

hoặc

Mã:

="Đây là hoa hậu lớp 10A"&InsertPic(C27)

mình đang có một vấn đề nhờ bạn xem tiếp dùm.
Hiện file excel và thư mục(folder) hình chung trong cùng thư mục như vậy thư mục hình của mình nằm ở một đường dẫn khác thì chỉnh code lại có chạy được không? và chỉnh code lại như thế nào? Bạn nghiêng cứu dùm mình nhé.
Ví dụ đường dẫn của thư mục hình là: Y:\My Picture\Staff

siwtom · 5/7/14

vuongtoituonglai đã viết:
mình đang có một vấn đề nhờ bạn xem tiếp dùm.
Hiện file excel và thư mục(folder) hình chung trong cùng thư mục như vậy thư mục hình của mình nằm ở một đường dẫn khác thì chỉnh code lại có chạy được không? và chỉnh code lại như thế nào? Bạn nghiêng cứu dùm mình nhé.
Ví dụ đường dẫn của thư mục hình là: Y:\My Picture\Staff

Tức tập tin Excel và thư mục có chứa ảnh - tức thư mục Staff - cùng nằm trong thư mục "My Picture"? Vì chỗ đỏ đỏ nói thế.

Nếu thế thì trong code những chỗ có ThisWorkbook.Path & "\" thì thay bằng ThisWorkbook.Path & "\Staff\"

vuongtoituonglai · 5/7/14

siwtom đã viết:
Tức tập tin Excel và thư mục có chứa ảnh - tức thư mục Staff - cùng nằm trong thư mục
"My Picture"? Vì chỗ đỏ đỏ nói thế.

Nếu thế thì trong code những chỗ có ThisWorkbook.Path & "\" thì thay bằng ThisWorkbook.Path & "\Staff\"

ý mình là file excel nằm 1 thư mục file hình nằm một thư mục khác nhé bạn.

sealand · 5/7/14

Xin lỗi bác Siwtom, em chen ngang vào 1 chút (Vì hơi hướng nhiệt đọ còn cao hay sao ấy...)

Đối với hàm này, để có thể load ảnh thì phải chỉ rõ file đó là file nào,đuôi gì, nằm ở đâu?
Phân tích câu lệnh sau:

ThisWorkbook.Path & "\" & picname & ".jpg"

Đoạn màu đỏ cho vị trí ở đâu. Ví dụ: "D:\Cac file GPE\"
Đoạn màu xanh cho tên file. Ví dụ "Hong001"
Đoạn màu nâu cho biết dạng file (Đuôi mở rộng) Ví dụ:".jpg"

Gộp lại ta được:

"D:\Cac file GPE\Hong001.jpg"
Function InsertPic(ByVal picname As String) As StringDim fullName As String, pic As Shape, cell_ As range, fs As ObjectDim mPath as stringmPath=Thisworkbook.worksheets(“Sheet1”).[D1].Value Set cell_ = Application.ThisCell On Error Resume Next cell_.Parent.Shapes(cell_.Address).Delete If Err.Number Then Err.Clear On Error GoTo 0 Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(mPath & picname & ".jpg") Then fullName = picname & ".jpg" ElseIf fs.FileExists(mPath & picname & ".bmp") Then fullName = picname & ".bmp" End If If fullName <> "" Then Set pic = cell_.Parent.Shapes.AddPicture(mPath & fullName, _ msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height) pic.LockAspectRatio = msoTrue pic.Name = cell_.Address End If Set cell_ = Nothing Set fs = NothingEnd Function
Tóm lại là cung cấp 1 chuỗi nêu đủ đường dẫn-Tên file-Loại file
Giờ bạn muốn thay đường dẫn đến vị trí khác thì bạn phải báo cho nó biết thay vì lấy theo ThisWorkbook.Path l chẳng hạn bạn ghi đường dẫn tại ô D1 trên Sheet1="D:\Cac file GPE\". Giờ bạn sửa Code như sau là ổn

Mã:

Function InsertPic(ByVal picname As String) As String
Dim fullName As String, pic As Shape, cell_ As range, fs As Object
Dim mPath as string
mPath=Thisworkbook.worksheets(“Sheet1”).[D1].Value
    Set cell_ = Application.ThisCell 
   On Error Resume Next
    cell_.Parent.Shapes(cell_.Address).Delete 
   If Err.Number Then Err.Clear
    On Error GoTo 0
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(mPath & picname & ".jpg") Then  
      fullName = picname & ".jpg"  
  ElseIf fs.FileExists(mPath & picname & ".bmp") Then 
       fullName = picname & ".bmp" 
   End If 
   If fullName <> "" Then
        Set pic = cell_.Parent.Shapes.AddPicture(mPath & fullName, _ 
           msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height) 
       pic.LockAspectRatio = msoTrue
        pic.Name = cell_.Address
    End If 
   Set cell_ = Nothing
    Set fs = Nothing
End Function

Bạn truyền đường dẫn cho Hàm qua biến mPath (Bạn cũng có thể khai thẳng trong Hàm bằng cách thay đoạn

mPath=Thisworkbook.worksheets(“Sheet1”).[D1].Value
Thành:
mPath="D:\Cac file GPE\")

(Không biết có đúng câu hỏi không nữa đây?)

siwtom · 5/7/14

sealand đã viết:
Xin lỗi bác Siwtom, em chen ngang vào 1 chút

Có gì đâu mà bạn xin lỗi. Nếu người hỏi ngoài thư mục Y:\My Picture\Staff còn đưa thêm thư mục của tập tin Excel thì ai cũng hiểu. Còn thế kia thì tôi hiểu lầm.
Được bạn giúp hộ thì tôi càng đỡ nhọc hơn. Cám ơn bạn.

Trợ giúp về hàm auto insert picture (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

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

Thành viên gạo cội

Thành viên gạo cội

File đính kèm

Thành viên mới

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

Thành viên gắn bó

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

Thành viên gạo cội

Thành viên gắn bó

Đếm ngược thời gian