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.

ptm0412 · 29/9/09

Giúp Chèn hình ảnh vào cột C theo đường dẫn ở cột B.

Có bạn nhắn tin nhờ tôi làm giúp như sau:

chiphoi3 đã viết:
Chèn hình ảnh tự động
Dear ptm0412,

Mình vừa gia nhập diễn đàn, mình đang cần tìm giải pháp để tự động cập nhật ảnh 3/4 cho tất cả nhân viên của mình. Đi dạo 1 vòng quanh các diễn đàn thì nghe mọi người nói là ptm có thể giúp đỡ được nên mạo muội pm. Hy vọng ko làm phiền ptm

Hiện tại mình có 1 spreadsheet trong đó column A là ID của nhân viên, và column B là đường dẫn đến ảnh 3/4 của nhân viên đó. Ko biết có cách nào để tự động chèn hình ảnh của nhân viên đó (dựa trên đường dẫn ở column B) vào column C hay ko. Nếu viết được thành công thức thì tốt quá.

Thêm 1 vấn đề nữa là hình ảnh insert vào sẽ tự động fit với kích thước cell định sẵn (vì có 1 số ảnh 2/3,3/4 và cả 4/6)

Rất mong được ptm giúp đỡ.
Thân.

Tôi đang mệt nên không giúp được, nhờ mọi người làm dùm. Xin cám ơn.

sealand · 29/9/09

Bạn xem có phải thế này không? (Lưu ý bạn phải giải nén ra máy mới chạy được vì lúc đó mới có địa chỉ của ảnh) Cái ví dụ của mình như vậy chắc bạn biết cách đưa nó vào nơi bạn muốn

khoi.tb · 21/7/11

Bạn tham khảo bài toán này tương tự của bạn và họ có solutions với đoạn code dưới đây

I have an image folder in my documents containing pictures of my entire inventory. The file names of the images are their style #'s. Now, in microsoft excel 2007, i have a list of style #'s in column A, and i want to automatically insert the associated images from my image folder into the respective cells in column B

“This macro hasn't been tested with Excel 2007, but does work with Excel 2003. Give it try. You will need to change the folder name in PicPath to the folder name you are using. Currently it is "Images". Row 1 is assumed to have headers, so the macro starts with cell "A2".

Sub InsertPics()

Dim Cell As Range
Dim PicPath As String
Dim Pic As Excel.Picture
Dim Rng As Range
Dim RngEnd As Range
Dim WSH As Object

Set Rng = Range("A2")
Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Range(Rng, RngEnd))

Set WSH = CreateObject("WScript.Shell")
PicPath = WSH.SpecialFolders("MyDocuments") & "\Images\"

Application.ScreenUpdating = False

For Each Cell In Rng
If Dir(PicPath & Cell) <> "" Then
Set Pic = ActiveSheet.Pictures.Insert(PicPath & Cell)
With Pic
.Left = Cell.Offset(0, 1).Left
.Top = Cell.Offset(0, 1).Top
.Width = Cell.Offset(0, 1).Width
.Height = Cell.Offset(0, 1).Height
End With
End If
Next Cell

Application.ScreenUpdating = True

Set WSH = Nothing

End Sub

tobuvn · 20/6/14

Hay quá, cảm ơn pro!

Cho em hỏi một chút là em muốn thay đổi drop-drown mã số thành mình tự gõ thì làm như thế nào ạ? Em thử nhưng chưa được ạ. Khi em án Alt + f11 ra code nhưng không thấy phần định dạng ảnh (vị trí, kích thước) ở chỗ nào ạ. Em mới vào nghề mong bác @sealand và các bác giúp đỡ ạ!

sealand · 20/6/14

Bạn hoàn toàn có thể tự gõ được chứ. Chỉ có điều phải lưu ý: Đối với 1 ô Excel ở dạng General bạn gõ 0003 lập tức nó hiểu bạn nhập số và chuyển thành 3. Vậy là không đúng với Validation rồi. Có 2 cách sử lý trường hợp này:

1/ Gõ dấu nháy " ' " kèm theo 0003

2/Định dạng ô đó là Text

Riêng về kích cỡ bạn là như sau: Vì đây là Frame ảnh và ta định dạng nó là tự động giãn đầy nên dù ảnh to nhỏ hay vuông, chữ nhật tự động giãn đầy. Để tham khảo bạn làm như sau:

Vào Menu View--Toolbars---Control Toolbox (Chọn)
Trên Control Toolbox nhấn hình E ke
Nhấn chuột lên hình sẽ co giãn được hình. Nhấn chuột phải chọn Properties sẽ vào thiết lập cho hình.

Mạnh dạn vọc đi xem sao.

tobuvn · 20/6/14

Cháu cảm ơn chú @sealand, cháu quên mất format cell ạ!
Nói thật với chú cháu là giáo viên và chưa học VBA bao gờ ạ, mọi cái với cháu chỉ là xử lý với một số hàm đơn giản. Cháu mới mở cửa hàng nên rất cần ứng dụng này, cháu mong chú giúp cháu kết nối file excel tự động với ảnh như trên chú đã làm với ạ. Những thông tin khác thì cháu vọc, nghiên cứu trên mạng thì cháu đã làm xong hết rồi ạ. Cháu cảm ơn chú @sealand!

sealand · 20/6/14

Việc load ảnh dựa vào Code sau:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$21" Then
Sheet1.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
End If
End Sub

Bạn xem trong file Convert nha, mình dùng Excel 2003 thôi.

tobuvn · 20/6/14

Vâng, cháu dùng thấy tốt lắm rồi chú ạ. Cháu cảm ơn chú rất nhiều ạ!
Chú ơi, cháu chèn thêm một đối tượng ảnh nữa làm mã vạch thì bị lỗi chú ạ. Bình thường cháu làm thủ công phát cho học sinh là thẻ có mã vạch.
Cháu copy thêm một ảnh image1 và đổi tên thành image2, sau đó cháu paste tiếp code cho image2. Trong code cháu đổi image1 thành image2, .jpg thành .png nhưng bị lỗi chú ạ. Bình thường cháu cứ tưởng như mọi lần mọi người chỉ cần hướng dẫn cho một cái, cái còn lại cháu có thể hoàn thành, nhưng không có kiến thức về VBA cháu lúng túng quá ạ.
http://www.mediafire.com/download/kcxgda65ed8so2t/GUI_CHU.rar

siwtom · 20/6/14

tobuvn đã viết:
Vâng, cháu dùng thấy tốt lắm rồi chú ạ. Cháu cảm ơn chú rất nhiều ạ!
Chú ơi, cháu chèn thêm một đối tượng ảnh nữa làm mã vạch thì bị lỗi chú ạ. Bình thường cháu làm thủ công phát cho học sinh là thẻ có mã vạch.
Cháu copy thêm một ảnh image1 và đổi tên thành image2, sau đó cháu paste tiếp code cho image2. Trong code cháu đổi image1 thành image2, .jpg thành .png nhưng bị lỗi chú ạ. Bình thường cháu cứ tưởng như mọi lần mọi người chỉ cần hướng dẫn cho một cái, cái còn lại cháu có thể hoàn thành, nhưng không có kiến thức về VBA cháu lúng túng quá ạ.
http://www.mediafire.com/download/kcxgda65ed8so2t/GUI_CHU.rar

Nếu vì lý do nào đấy không thể dùng code (cơ quan cấm?) hoặc không muốn đính kèm thư mục ảnh khi chia sẻ thì bạn cũng có thể thêm sheet mới --> Insert bằng tay ảnh vào sheet mới --> liên kết ô mã/tên với ảnh trên sheet mới.

tobuvn · 20/6/14

Nhưng số lượng khác hàng của em cả hàng trăm người, có tương lai tới cả nghìn người nên nếu chèn vào trong một file sẽ tạo ra một file có dung lượng quá lớn bác @siwtom ạ! Vấn đề của em chỉ còn một chút nữa thôi mà em chưa giải quyết được. Mong các bác chỉ giáo ạ!

sealand · 20/6/14

Có mấy vấn đề lưu ý:

1/ Em lưu ý file *.png không phải dạng file ảnh có thể load lên Image được. Để load em dùng phần mềm nào đó (Snagit chẳng hạn) convert sang dạng file *.jpg để có thể load được.

2/Code load ảnh em viết như sau:

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")
Sheet1.Image2.Picture = LoadPicture(ThisWorkbook.Path & "\" & Target.Value & "a.jpg")
End If
End Sub

3/ Về mã vạch: Không mấy ai dùng dạng ảnh như em vì nó mờ nên đầu đọc mã vạch sẽ đọc không chính xác và báo lỗi loạn cả lên.
Em tải font mã vạch trên mạng về và format chuỗi mã HS theo font đó là có mã vạch nét như "SONY"
Sau này khi mượn thuê hay trả sách em quét 1 nhát là dữ liệu tự động cập nhật khỏi cần gõ tay mất công

Tải và cài đặt font mã vạch có thể tham khảo ở đây:http://www.cds.vn/index.aspx?action=LTK&IDCM=101&id_ntc=101&menusub=135&i=6&ic=5&lan=1

tobuvn · 21/6/14

Tuyệt vời quá ạ. Cháu cảm ơn chú đã giúp đỡ cháu rất nhiều ạ!

vuongtoituonglai · 21/6/14

Insert Picture Vào Excel

sealand đã viết:
Bạn xem có phải thế này không? (Lưu ý bạn phải giải nén ra máy mới chạy được vì lúc đó mới có địa chỉ của ảnh) Cái ví dụ của mình như vậy chắc bạn biết cách đưa nó vào nơi bạn muốn

Bài #3 của bạn Sealand hay quá mình cũng đang cần làm về vấn đề này nhờ bạn giúp dùm. File của mình hơi khác một tí bạn xem file giúp mình nhé. Về hình thì mình sử dụng 2 dạng đuôi jpg và bmp. sheet Data của mình rất nhiều và file hình cũng rất nhiều hình gần 10.000 hình nên mình đã bỏ bớt. Bạn xem file nhé.

ndu96081631 · 21/6/14

vuongtoituonglai đã viết:
Bài #3 của bạn Sealand hay quá mình cũng đang cần làm về vấn đề này nhờ bạn giúp dùm. File của mình hơi khác một tí bạn xem file giúp mình nhé. Về hình thì mình sử dụng 2 dạng đuôi jpg và bmp. sheet Data của mình rất nhiều và file hình cũng rất nhiều hình gần 10.000 hình nên mình đã bỏ bớt. Bạn xem file nhé.

Tặng bạn code này:

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

Việc của bạn là:
- Cho code trên vào 1 Module
- Xong, ra ngoài bảng tính, gõ vào cell C28 công thức =Commpic(C27&".jpg")
Vậy là xong

vuongtoituonglai · 22/6/14

ndu96081631 đã viết:

Tặng bạn code này:

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

Việc của bạn là:
- Cho code trên vào 1 Module
- Xong, ra ngoài bảng tính, gõ vào cell C28 công thức =Commpic(C27&".jpg")
Vậy là xong

Dạ, cảm ơn thầy ndu96081361 nhiều nhưng em có nêu vấn đề là file hình của em có 2 dạng đuôi là jpg và bmp với công thức thầy cho thì những hình có đuôi bmp sẽ không lấy vào được thầy à, thầy xem lại dùm em với. Thầy chỉnh cho hình nằm gọn trong ô nhưng vẫn còn nhìn thấy phần Border, khi nhập công thức vào và kéo các ô thì phần Border bị mất thầy ơi Thầy xem lại dùm em luôn nhé. Em cảm ơn Thầy nhiều.

ndu96081631 · 22/6/14

vuongtoituonglai đã viết:
Dkhi nhập công thức vào và kéo các ô thì phần Border bị mất thầy ơi Thầy xem lại dùm em luôn nhé

Mấy vụ format linh tinh gì đó thì tôi không biết đâu, bạn có thể tự làm bằng tay (vì dù là công thức nào thì vẫn phải làm vậy thôi)

vuongtoituonglai đã viết:
Dạ, cảm ơn thầy ndu96081361 nhiều nhưng em có nêu vấn đề là file hình của em có 2 dạng đuôi là jpg và bmp với công thức thầy cho thì những hình có đuôi bmp sẽ không lấy vào được thầy à.

Hàm tôi viết là để cho nhiều người xài, mang tính tổng quát. Nếu sửa lại theo ý bạn thì... mình bạn xài và chẳng ai xài được (vậy nên tôi không có hứng thú)
Bạn tìm cách khác vậy!

siwtom · 22/6/14

vuongtoituonglai đã viết:
Bài #3 của bạn Sealand hay quá mình cũng đang cần làm về vấn đề này nhờ bạn giúp dùm. File của mình hơi khác một tí bạn xem file giúp mình nhé. Về hình thì mình sử dụng 2 dạng đuôi jpg và bmp. sheet Data của mình rất nhiều và file hình cũng rất nhiều hình gần 10.000 hình nên mình đã bỏ bớt. Bạn xem file nhé.

Có nhiều cách tạo ảnh. Làm bằng tay thì vd. dùng Insert. Dùng code cũng có nhiều kiểu tạo. Vậy cái mà ta muốn không phải là tạo kiểu gì, vì tha hồ mà lựa chọn. Cái ta muốn là không phải làm bằng tay. Là làm sao để Excel tự gọi ta để ta làm cái việc tạo ảnh. Một trong những cách để Excel gọi ta là viết hàm tự tạo và dùng hàm đó trong công thức. Như vậy thì Excel phải gọi ta.
Hàm không chỉ làm việc tính toán, thậm chí code của hàm không bắt buộc phải tính toán. Code của hàm có thể chỉ mở tập tin trên đĩa rồi đóng lại để giết thời gian. Có thể kết nối mạng. Có thể làm bất cứ việc gì, tất nhiên là cả việc tạo ảnh và định vị nó.

Vậy thì ta viết hàm và code của hàm chả tính toán gì cả, trả về kết quả ở dạng chuỗi rỗng. Nhưng code sẽ làm việc tạo ảnh.

Tóm lại là ta viết hàm và dùng nó trong công thức. Lúc đó Excel sẽ tự gọi hàm của ta. Code hàm của ta chỉ chờ cơ hội đó để tạo và định vị ảnh. Thế thôi.

Mã:

Function InsertPic(ByVal picname As String) As String
Dim pic As Shape, cell_ As range
    Set cell_ = Application.ThisCell
    On Error Resume Next
    cell_.Parent.Shapes(cell_.Address).Delete
    On Error GoTo 0
    Set pic = cell_.Parent.Shapes.AddPicture(ThisWorkbook.Path & "\" & picname, _
        msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height)
    pic.LockAspectRatio = msoTrue
    pic.Name = cell_.Address
    Set cell_ = Nothing
End Function

Có hàm rồi thì phải dùng nó trong công thức để Excel tự gọi nó.

Vậy công thức có thể là

Mã:

=InsertPic(C27&".bmp")

và cũng có thể là

Mã:

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

Công thức thế nào cũng được nhưng phải dùng hàm trong công thức để Excel gọi nó.

vuongtoituonglai · 22/6/14

siwtom đã viết:
Có nhiều cách tạo ảnh. Làm bằng tay thì vd. dùng Insert. Dùng code cũng có nhiều kiểu tạo. Vậy cái mà ta muốn không phải là tạo kiểu gì, vì tha hồ mà lựa chọn. Cái ta muốn là không phải làm bằng tay. Là làm sao để Excel tự gọi ta để ta làm cái việc tạo ảnh. Một trong những cách để Excel gọi ta là viết hàm tự tạo và dùng hàm đó trong công thức. Như vậy thì Excel phải gọi ta.
Hàm không chỉ làm việc tính toán, thậm chí code của hàm không bắt buộc phải tính toán. Code của hàm có thể chỉ mở tập tin trên đĩa rồi đóng lại để giết thời gian. Có thể kết nối mạng. Có thể làm bất cứ việc gì, tất nhiên là cả việc tạo ảnh và định vị nó.

Vậy thì ta viết hàm và code của hàm chả tính toán gì cả, trả về kết quả ở dạng chuỗi rỗng. Nhưng code sẽ làm việc tạo ảnh.

Tóm lại là ta viết hàm và dùng nó trong công thức. Lúc đó Excel sẽ tự gọi hàm của ta. Code hàm của ta chỉ chờ cơ hội đó để tạo và định vị ảnh. Thế thôi.

Mã:

Function InsertPic(ByVal picname As String) As String Dim pic As Shape, cell_ As range Set cell_ = Application.ThisCell On Error Resume Next cell_.Parent.Shapes(cell_.Address).Delete On Error GoTo 0 Set pic = cell_.Parent.Shapes.AddPicture(ThisWorkbook.Path & "\" & picname, _ msoFalse, msoTrue, cell_.left, cell_.top, cell_.Width, cell_.Height) pic.LockAspectRatio = msoTrue pic.Name = cell_.Address Set cell_ = Nothing End Function

Có hàm rồi thì phải dùng nó trong công thức để Excel tự gọi nó.

Vậy công thức có thể là

Mã:

=InsertPic(C27&".bmp")

và cũng có thể là

Mã:

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

Công thức thế nào cũng được nhưng phải dùng hàm trong công thức để Excel gọi nó.

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á.

ndu96081631 · 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á.

Cách đơn giản nhất: Convert toàn bộ bmp sang jpg (hoặc ngược lại)
Chuyện dễ như ăn khoai. Dùng phần mềm sẽ cho kết quả trong vài giây

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.

vuongtoituonglai · 5/7/14

sealand đã viết:
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?)

Mình đang lờ mờ với đoạn code không biết phải sửa như thế nào để chạy được.
File hình của mình nằm ở đường dẫn: Y:\My Picture\Staff
File excel của mình nằm ở đường dẫn: Z:\So do cong doan\L01
Bạn xem chỉ lại dùm mình nhé.

sealand · 5/7/14

Không quan tâm file Excel nằm ở đâu, để tìm hiểu thì bạn lưu ý các đoạn màu đỏ. Code này bạn cứ chép vào là chạy.

Mã:

Function InsertPic(ByVal picname As String) As String
Dim fullName As String, pic As Shape, cell_ As range, fs As Object
[COLOR=#ff0000]Dim mPath as string
mPath="Y:\My Picture\Staff\"
[/COLOR]    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([COLOR=#ff0000]mPath & picname & ".jpg"[/COLOR]) Then  
      [COLOR=#ff0000]fullName = picname & ".jpg"[/COLOR]  
  ElseIf fs.FileExists([COLOR=#ff0000]mPath & picname & ".bmp"[/COLOR]) Then 
       [COLOR=#ff0000]fullName = picname & ".bmp"[/COLOR] 
   End If 
   If [COLOR=#ff0000]fullName <> ""[/COLOR] Then
        Set pic = cell_.Parent.Shapes.AddPicture([COLOR=#ff0000]mPath & fullName[/COLOR], _ 
           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

vuongtoituonglai · 5/7/14

sealand đã viết:

Không quan tâm file Excel nằm ở đâu, để tìm hiểu thì bạn lưu ý các đoạn màu đỏ. Code này bạn cứ chép vào là chạy.

Mã:

Function InsertPic(ByVal picname As String) As String
Dim fullName As String, pic As Shape, cell_ As range, fs As Object
[COLOR=#ff0000]Dim mPath as strin654g
mPath="Y:\My Picture\Staff\"
[/COLOR]    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([COLOR=#ff0000]mPath & picname & ".jpg"[/COLOR]) Then  
      [COLOR=#ff0000]fullName = picname & ".jpg"[/COLOR]  
  ElseIf fs.FileExists([COLOR=#ff0000]mPath & picname & ".bmp"[/COLOR]) Then 
       [COLOR=#ff0000]fullName = picname & ".bmp"[/COLOR] 
   End If 
   If [COLOR=#ff0000]fullName <> ""[/COLOR] Then
        Set pic = cell_.Parent.Shapes.AddPicture([COLOR=#ff0000]mPath & fullName[/COLOR], _ 
           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

Cảm ơn bạn nhé. Mình làm được rồi.

Thuonghttt · 8/4/16

sealand đã viết:

Không quan tâm file Excel nằm ở đâu, để tìm hiểu thì bạn lưu ý các đoạn màu đỏ. Code này bạn cứ chép vào là chạy.

Mã:

Function InsertPic(ByVal picname As String) As String
Dim fullName As String, pic As Shape, cell_ As range, fs As Object
[COLOR=#ff0000]Dim mPath as string
mPath="Y:\My Picture\Staff\"
[/COLOR]    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([COLOR=#ff0000]mPath & picname & ".jpg"[/COLOR]) Then  
      [COLOR=#ff0000]fullName = picname & ".jpg"[/COLOR]  
  ElseIf fs.FileExists([COLOR=#ff0000]mPath & picname & ".bmp"[/COLOR]) Then 
       [COLOR=#ff0000]fullName = picname & ".bmp"[/COLOR] 
   End If 
   If [COLOR=#ff0000]fullName <> ""[/COLOR] Then
        Set pic = cell_.Parent.Shapes.AddPicture([COLOR=#ff0000]mPath & fullName[/COLOR], _ 
           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

Anh ơi e mới học vba e làm theo code của anh mà sau khi ghi hàm xong nó chỉ trả về giá trị #name chứ k thấy có hình gì hết là bị làm sao ạ

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

Bad Excel Member

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

File đính kèm

Thành viên mới

Thành viên mới

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

Thành viên mới

File đính kèm

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

File đính kèm

Thành viên mới

Thành viên gắn bó

Thành viên mớ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

File đính kèm

Huyền thoại GPE

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

Huyền thoại GPE

Thành viên gắn bó

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

Huyền thoại GPE

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ó

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

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

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

Thành viên mới

Thời gian đếm ngược.