Chèn hình vào cell bằng hàm tự tạo (1 người xem)

anhtuan1066 · 9/7/11

Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String
  On Error Resume Next
  Application.Volatile
  Cel.Comment.Delete
  If Cel.Comment Is Nothing Then Cel.AddComment
  Cel.Comment.Text vbLf
  With Cel.Comment.Shape
    .Left = Cel.Left: .Top = Cel.Top: .Visible = True
    .Width = Cel.Width: .Height = Cel.Height
    .Fill.UserPicture Pic
  End With
End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

sujukia · 26/3/15

phucymvn đã viết:
Bạn làm xong rồi save as sang excel 2003-2007 gửi cho đối tác OK nhé

nếu gởi như vậy mình phải gởi kèm hình ảnh theo mới mở được mà bạn!

mình có 1 vấn đề mong các bạn chỉ giúp! đó là làm sao ko hiện hình ảnh tại ô muốn hiện nhưng chỉ hiện, khi đưa chuột vào mũi tên đỏ thì mới hiện hình ra

xin cám ơn!

lehuychau · 10/4/15

Chao cac ban. chi dùm mình với. sao mình làm tương tự như file có sẵn, chỉ thêm mình và kéo xuống nhưng không thấy ra hình. mong các bạn chỉ dùm. minh xin cám ơn. xem file dinh kèm.

lehuychau · 11/4/15

Chao cac ban. chi dùm mình với. sao mình làm tương tự như file có sẵn, chỉ thêm mình và kéo xuống nhưng không thấy ra hình. mong các bạn chỉ dùm. minh xin cám ơn. xem file dinh kèm.

tueyennhi · 17/4/15

Bạn ơi có cách nào để ảnh không chèn full cell mà sẽ cách mỗi cạnh một khoảng nhất định mình muốn (ví dụ 1milimet) sẽ thẩm mỹ hơn, anh chị nào biết chỉ giúp em với

tueyennhi · 17/4/15

Như vậy là không có cách nào

Ngoai Thanh · 17/4/15

tueyennhi đã viết:
Như vậy là không có cách nào

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

havietanh84 · 27/5/15

Xin chào các anh, em có vấn đề này cần được sự giúp đỡ!
Em có các ảnh nằm trong các cell của file excel, các anh chỉ giúp em hàm để select được ảnh ở trong cell khi mình biết vị trí của cell cần select ảnh (ảnh nằmtrong cell đó)
Thanks pro!

donghocexcel · 29/5/15

Chào anh Tuấn,
Anh có thể giúp em cách đưa hình có sẵn vào trang tính toán (sheet-Draft) theo điều kiện đầu vào ở trang khác (sheet -Cal), như file đính kèm được không ạ. Em giải thích về điều kiện như sau:
1. Sheet cal: số tấm thép (kích thước bản rộng W=2420mm) cần để lắp dựng đạt chiều cao bồn (H16000) là 07 tấm (ô B19), trong đó có 06 tấm nguyên bản rộng W2420 và 01 tấm thiếu W1480.
=>Cần thể hiện minh họa sang Sheet Draft là:
-Copy hình vẽ minh họa tấm nguyên (góc dưới bên phải) chống liên tiếp lên tấm đáy bồn (#1, cố định) theo thứ tự từ tấm #2 đến tấm #6.
-Copy hình minh họa tấm thiếu (nằm trên tấm nguyên) lên vị trí tấm thứ #7 (trên cùng).
-Copy hình minh họa tấm mái bồn (tank roof) lên trên tấm #7.
2. Nếu Bồn có chiều cao H16940 thì ta có 07 tấm nguyên W2420, khi đó ở Sheet Draft hình minh họa bồn là 07 tấm nguyên kích thước giống nhau, và tank roof trên cùng.

Cảm ơn anh Tuấn nhiều.

Prince_HCM · 3/6/15

Xin chào,
Tôi đang rất cần cách chèn hình vào Excel để tập hợp lên kế hoạch tháng. Như bị đắm tàu mà với được phao, gặp ngay vài viết rất hữu ích.
Thật sự tôi không biết gì về VBA cho nên tôi xin nhờ giúp đỡ dựa trên file của anh ndu96081631 với yêu cầu một số thay đổi sau:
1) Insert hình với kích cỡ nhỏ vào 1 sheet chỉ để làm dữ liệu xuất sang sheet khác
2) Xuất sang sheet khác với sắp xếp hình ảnh cứ 4 hình 1 trang có tên file phía dưới hình.
Chân thành cám ơn.

phuongbee · 4/9/15

hôm trước em tải file này của anh về và làm được, nay cần dùng đến mở ra không hiểu sao không tài nào làm nổi nữa, giúp em với!

Ngoai Thanh · 6/10/15

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

Xin hỏi các bạn, khi ta sử dụng hàm để chèn ảnh vào comment ,khí có ảnh thì vô tư rồi . Nhưng khi trường hợp có tên, nhưng không có ảnh thì nó chỉ cho khung comment trống . Vậy bổ xung code thế nào để nó tự xóa các comment không có ảnh ?

ndu96081631 · 6/10/15

Ngoai Thanh đã viết:
Xin hỏi các bạn, khi ta sử dụng hàm để chèn ảnh vào comment ,khí có ảnh thì vô tư rồi . Nhưng khi trường hợp có tên, nhưng không có ảnh thì nó chỉ cho khung comment trống . Vậy bổ xung code thế nào để nó tự xóa các comment không có ảnh ?

Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _
                Optional ByVal ScaleWidth As Single = 1, _
                Optional ByVal ScaleHeight As Single = 1) As String
  Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean
  On Error Resume Next
  Application.Volatile
  Set fso = CreateObject("Scripting.FileSystemObject")
  If PicCel Is Nothing Then Set PicCel = Application.ThisCell
  PicCel(1, 1).Comment.Delete
  If Left(PicPath, 7) = "http://" Then
    bChk = URLExists(PicPath)
  Else
    bChk = fso.FileExists(PicPath)
    If bChk = False Then
      PicPath = ThisWorkbook.Path & "\" & PicPath
      bChk = fso.FileExists(PicPath)
    End If
  End If
  If bChk Then
    If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment
    PicCel(1, 1).Comment.Text vbLf
    Set mRng = PicCel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = PicCel(1, 1)
    Set cmt = mRng(1, 1).Comment
    cmt.Visible = True
    With cmt.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.ForeColor.RGB = PicCel.Interior.Color
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle
      .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle
      .Fill.UserPicture PicPath
    End With
  End If
End Function
Private Function URLExists(ByVal URL As String) As Boolean
  Application.Volatile
  On Error Resume Next
  If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL
  With CreateObject("MSXML2.XMLHTTP")
    .Open "HEAD", URL, False: .send
    URLExists = .Status = 200
  End With
End Function

Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau

Ngoai Thanh · 6/10/15

ndu96081631 đã viết:
Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _ Optional ByVal ScaleWidth As Single = 1, _ Optional ByVal ScaleHeight As Single = 1) As String Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean On Error Resume Next Application.Volatile Set fso = CreateObject("Scripting.FileSystemObject") If PicCel Is Nothing Then Set PicCel = Application.ThisCell PicCel(1, 1).Comment.Delete If Left(PicPath, 7) = "http://" Then bChk = URLExists(PicPath) Else bChk = fso.FileExists(PicPath) If bChk = False Then PicPath = ThisWorkbook.Path & "\" & PicPath bChk = fso.FileExists(PicPath) End If End If If bChk Then If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment PicCel(1, 1).Comment.Text vbLf Set mRng = PicCel(1, 1).MergeArea If mRng Is Nothing Then Set mRng = PicCel(1, 1) Set cmt = mRng(1, 1).Comment cmt.Visible = True With cmt.Shape .LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Shadow.Visible = msoFalse .Line.ForeColor.RGB = PicCel.Interior.Color .AutoShapeType = msoShapeRectangle .Left = mRng.Left: .Top = mRng.Top .Width = mRng.Width: .Height = mRng.Height .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle .Fill.UserPicture PicPath End With End If End Function Private Function URLExists(ByVal URL As String) As Boolean Application.Volatile On Error Resume Next If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL With CreateObject("MSXML2.XMLHTTP") .Open "HEAD", URL, False: .send URLExists = .Status = 200 End With End Function

Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau

Chiều nhà em đi vắng , chưa hồi âm được . Cám ơn thày !

khongnhienttt · 8/10/15

ndu96081631 đã viết:

Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _
                Optional ByVal ScaleWidth As Single = 1, _
                Optional ByVal ScaleHeight As Single = 1) As String
  Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean
  On Error Resume Next
  Application.Volatile
  Set fso = CreateObject("Scripting.FileSystemObject")
  If PicCel Is Nothing Then Set PicCel = Application.ThisCell
  PicCel(1, 1).Comment.Delete
  If Left(PicPath, 7) = "http://" Then
    bChk = URLExists(PicPath)
  Else
    bChk = fso.FileExists(PicPath)
    If bChk = False Then
      PicPath = ThisWorkbook.Path & "\" & PicPath
      bChk = fso.FileExists(PicPath)
    End If
  End If
  If bChk Then
    If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment
    PicCel(1, 1).Comment.Text vbLf
    Set mRng = PicCel(1, 1).MergeArea
    If mRng Is Nothing Then Set mRng = PicCel(1, 1)
    Set cmt = mRng(1, 1).Comment
    cmt.Visible = True
    With cmt.Shape
      .LockAspectRatio = msoFalse
      .Placement = xlMoveAndSize
      .Shadow.Visible = msoFalse
      .Line.ForeColor.RGB = PicCel.Interior.Color
      .AutoShapeType = msoShapeRectangle
      .Left = mRng.Left: .Top = mRng.Top
      .Width = mRng.Width: .Height = mRng.Height
      .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle
      .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle
      .Fill.UserPicture PicPath
    End With
  End If
End Function
[COLOR=#0000cd]Private[/COLOR] Function URLExists(ByVal URL As String) As Boolean
  Application.Volatile
  On Error Resume Next
  If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL
  With CreateObject("MSXML2.XMLHTTP")
    [COLOR=#0000cd].Open "HEAD", URL, False: .send
    URLExists = .Status = 200[/COLOR]
  End With
End Function

xin thầy giải thích giúp em tại sao phải dùng Private ở function URLExists, và 2 dòng code em tô màu xanh có ý nghĩa gì ạ, và những phương thức đó tham khảo ở đâu, cám ơn thầy

langtuchungtinh360 · 16/11/15

ndu96081631 đã viết:
Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _ Optional ByVal ScaleWidth As Single = 1, _ Optional ByVal ScaleHeight As Single = 1) As String Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean On Error Resume Next Application.Volatile Set fso = CreateObject("Scripting.FileSystemObject") If PicCel Is Nothing Then Set PicCel = Application.ThisCell PicCel(1, 1).Comment.Delete If Left(PicPath, 7) = "http://" Then bChk = URLExists(PicPath) Else bChk = fso.FileExists(PicPath) If bChk = False Then PicPath = ThisWorkbook.Path & "\" & PicPath bChk = fso.FileExists(PicPath) End If End If If bChk Then If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment PicCel(1, 1).Comment.Text vbLf Set mRng = PicCel(1, 1).MergeArea If mRng Is Nothing Then Set mRng = PicCel(1, 1) Set cmt = mRng(1, 1).Comment cmt.Visible = True With cmt.Shape .LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Shadow.Visible = msoFalse .Line.ForeColor.RGB = PicCel.Interior.Color .AutoShapeType = msoShapeRectangle .Left = mRng.Left: .Top = mRng.Top .Width = mRng.Width: .Height = mRng.Height .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle .Fill.UserPicture PicPath End With End If End Function Private Function URLExists(ByVal URL As String) As Boolean Application.Volatile On Error Resume Next If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL With CreateObject("MSXML2.XMLHTTP") .Open "HEAD", URL, False: .send URLExists = .Status = 200 End With End Function

Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau

qua thời gian xử dụng em thấy có vài điều thế này, mong thầy xem xét, nếu được thì update cho bản sau he thầy.
thêm mắm muối thế nào để tự động nhận luôn đuôi mở rộng của tấm hình thầy
ví dụ tấm hình 1 tên 1.jpg
tấm hình 2 tên 2.png
hàm sẽ tự động tìm tại đường dẫn đó file tên như vậy và có đuôi mở rộng thỏa thì hiện tấm ảnh đó lên
và thầy có thể bổ xung thêm cho hàm nó mặc định đường dẫn là chung với file excel hiện hành (nếu file có sẵn) luôn được không thầy, nếu là file excel mới tạo (trường hợp hàm trên ở trong add ins) thì đường dẫn mặc đinh là C:\Users\Public\Pictures\
em xin ví dụ nếu là file có sẵn đường dẫn E:\ (code trên là addins) thì tại:
ô A1 là 1
ô A2 là D:\Anh\1
tương ứng ô B1, B2 sẽ là =commpic(RC[-1])
thì tại ô B1 sẽ xuất tấm hình tại đường dẫn E:\1.* (* sẽ là đuôi mở rộng, nếu có tấm hình nào tên là 1 - giả sử có 2 file 1.jpg 1.png thì ưu tiên 1.jpg trước)
tại ô B2 thì sẽ là tấm ảnh 1.* tại đường dẫn đó (* tương tự như trên)-cái này thì hàm trên làm được rồi
còn nếu là file mới tạo chưa lưu thì tại ô B1 sẽ lấy đường dẫn C:\Users\........\Picture\ file ảnh là 1.* (* tương tự như trên)
nếu em có diễn giải hơi loằng ngoằng thì thầy thông cảm bỏ quá cho em
thầy có thể cho nó tự update luôn hay không, chứ mỗi lần thay đổi lại nhấn F9
--------------------------
em xem lại thì thấy "ActiveWorkbook.Path" vậy 1 vấn đề đã giải quyết. còn vụ đuôi mở rộng
--------------------------
hên là đọc code thầy viết còn hiểu
ngồi 1 tí là ra

Mã:

  If Left(PicPath, 7) = "http://" Then
    bChk = URLExists(PicPath)
  Else
  
[COLOR=#ff0000]Tam = PicPath[/COLOR]
[COLOR=#ff0000]  Dim FormatPic[/COLOR]
[COLOR=#ff0000]  FormatPic = Array(".JPG", ".JPE", ".GIF", ".PNG", ".BMP")[/COLOR]
[COLOR=#ff0000]  For i = 0 To UBound(FormatPic)[/COLOR]
[COLOR=#ff0000]    bChk = fso.FileExists(PicPath)[/COLOR]
[COLOR=#ff0000]    If bChk = False Then[/COLOR]
[COLOR=#ff0000]      PicPath = ThisWorkbook.Path & "\" & Tam & FormatPic(i)[/COLOR]
[COLOR=#ff0000]      bChk = fso.FileExists(PicPath)[/COLOR]
[COLOR=#ff0000]      If bChk Then GoTo Nex[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
[COLOR=#ff0000]    Next i

[/COLOR][COLOR=#ff0000]If bChk = False Then[/COLOR]
[COLOR=#ff0000]  For i = 0 To UBound(FormatPic)[/COLOR]
[COLOR=#ff0000]    bChk = fso.FileExists(PicPath)[/COLOR]
[COLOR=#ff0000]    If bChk = False Then[/COLOR]
[COLOR=#ff0000]        PicPath = "C:\Users\" & Environ("Username") & "\Pictures\" & Tam & FormatPic(i)[/COLOR]
[COLOR=#ff0000]      bChk = fso.FileExists(PicPath)[/COLOR]
[COLOR=#ff0000]      If bChk Then GoTo Nex[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
[COLOR=#ff0000]    Next i[/COLOR]
[COLOR=#ff0000]End If[/COLOR]


[COLOR=#ff0000]Nex:[/COLOR]


  End If
  If bChk Then

vấn đề định dạng ảnh và đường dẫn C:\Users\........\Picture\ đã được giải quyết

Thanh Thinh · 27/11/15

Cam ơn bạn thật nhiều --=0

tueyennhi · 7/12/15

ndu96081631 đã viết:
Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _ Optional ByVal ScaleWidth As Single = 1, _ Optional ByVal ScaleHeight As Single = 1) As String Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean On Error Resume Next Application.Volatile Set fso = CreateObject("Scripting.FileSystemObject") If PicCel Is Nothing Then Set PicCel = Application.ThisCell PicCel(1, 1).Comment.Delete If Left(PicPath, 7) = "http://" Then bChk = URLExists(PicPath) Else bChk = fso.FileExists(PicPath) If bChk = False Then PicPath = ThisWorkbook.Path & "\" & PicPath bChk = fso.FileExists(PicPath) End If End If If bChk Then If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment PicCel(1, 1).Comment.Text vbLf Set mRng = PicCel(1, 1).MergeArea If mRng Is Nothing Then Set mRng = PicCel(1, 1) Set cmt = mRng(1, 1).Comment cmt.Visible = True With cmt.Shape .LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Shadow.Visible = msoFalse .Line.ForeColor.RGB = PicCel.Interior.Color .AutoShapeType = msoShapeRectangle .Left = mRng.Left: .Top = mRng.Top .Width = mRng.Width: .Height = mRng.Height .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle .Fill.UserPicture PicPath End With End If End Function Private Function URLExists(ByVal URL As String) As Boolean Application.Volatile On Error Resume Next If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL With CreateObject("MSXML2.XMLHTTP") .Open "HEAD", URL, False: .send URLExists = .Status = 200 End With End Function

Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau

Hay quá. Cuối cùng mong muốn bao lâu của em cũng có lời giải. Cho em hỏi thêm là khai báo đường dẫn ảnh ở đâu vậy? Và tại sao em không thêm đối số thì ảnh không chèn vào? Em dùng office 2015??

Thêm một điều này nữa không biết có đến thầy ndu không. Sau khi em chạy lệnh gọi ảnh. Em xóa hết hàm. save lại đuôi xlsm. Cho em hỏi có code nào thêm vào để nếu mình thay đổi độ rộng cell thì comment ảnh nó tự thay đổi theo không?

dauxom · 4/1/16

Chào anh ndu96081631
Hiện tại, đối với danh sách ngắn, em thường insert hết hình bằng hàm theo chủ đề này. Sau đó, muốn gửi ra ngoài thì em copy từng file ảnh (copy as picture) sau đó delete và cuối cùng là pastespecial as picture (jpeg) thì không cần phải gửi kèm folder hình. Vậy anh có cách nào chèn code vào theo ý tưởng này đc không?
cảm ơn

311280 · 9/1/16

dauxom đã viết:
Chào anh ndu96081631
Hiện tại, đối với danh sách ngắn, em thường insert hết hình bằng hàm theo chủ đề này. Sau đó, muốn gửi ra ngoài thì em copy từng file ảnh (copy as picture) sau đó delete và cuối cùng là pastespecial as picture (jpeg) thì không cần phải gửi kèm folder hình. Vậy anh có cách nào chèn code vào theo ý tưởng này đc không?
cảm ơn

Em cũng đang vướng mắc vấn đề giống thế, bac ndu đâu giúp anh em với ... hay anh em khác nào có thể giúp thì giúp, cảm ơn nhiều

kenh9 · 21/1/16

Các bạn cho mình hỏi thêm
Mình có 1 file đã chèn ảnh
Bây giờ mình làm công thức để chuyển hình ảnh từ file đó lên một file khác theo điều kiện

kenh9 · 22/1/16

kenh9 đã viết:
Các bạn cho mình hỏi thêm
Mình có 1 file đã chèn ảnh
Bây giờ mình làm công thức để chuyển hình ảnh từ file đó lên một file khác theo điều kiện

Không ai giúp mình hết vậy ta

ndu96081631 · 22/1/16

kenh9 đã viết:
Không ai giúp mình hết vậy ta

Có hiểu bạn nói gì đâu mà giúp
"chuyển hình ảnh từ file đó lên một file khác theo điều kiện" nghĩa là sao?

tueyennhi · 25/1/16

ndu96081631 đã viết:
Hàm CommPic phiên bản mới nhất với nhiều tùy chọn:

Mã:

Function CommPic(ByVal PicPath As String, Optional ByVal PicCel As Range, _ Optional ByVal ScaleWidth As Single = 1, _ Optional ByVal ScaleHeight As Single = 1) As String Dim mRng As Range, cmt As Comment, fso As Object, bChk As Boolean On Error Resume Next Application.Volatile Set fso = CreateObject("Scripting.FileSystemObject") If PicCel Is Nothing Then Set PicCel = Application.ThisCell PicCel(1, 1).Comment.Delete If Left(PicPath, 7) = "http://" Then bChk = URLExists(PicPath) Else bChk = fso.FileExists(PicPath) If bChk = False Then PicPath = ThisWorkbook.Path & "\" & PicPath bChk = fso.FileExists(PicPath) End If End If If bChk Then If PicCel(1, 1).Comment Is Nothing Then PicCel(1, 1).AddComment PicCel(1, 1).Comment.Text vbLf Set mRng = PicCel(1, 1).MergeArea If mRng Is Nothing Then Set mRng = PicCel(1, 1) Set cmt = mRng(1, 1).Comment cmt.Visible = True With cmt.Shape .LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Shadow.Visible = msoFalse .Line.ForeColor.RGB = PicCel.Interior.Color .AutoShapeType = msoShapeRectangle .Left = mRng.Left: .Top = mRng.Top .Width = mRng.Width: .Height = mRng.Height .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle .Fill.UserPicture PicPath End With End If End Function Private Function URLExists(ByVal URL As String) As Boolean Application.Volatile On Error Resume Next If Left(UCase(URL), 7) <> "HTTP://" Then URL = "http://" & URL With CreateObject("MSXML2.XMLHTTP") .Open "HEAD", URL, False: .send URLExists = .Status = 200 End With End Function

Khả năng của hàm:
- Như ý anh: Nếu đường dẫn không tồn tại, sẽ xóa Comment
- Cho phép chèn hình có trong ổ đĩa máy tính hoặc hình trên Web
- Tự động thay đổi size hình và dịch chuyển theo cell (khi cell thay đổi kích thước, chỉ cần bấm F9 để cập nhật)
- Cho phép thu nhỏ, phóng to hình tùy ý. Ví dụ =CommPic(A1, , 80%, 80%) có nghĩa là thu nhỏ chiều ngang và chiều dọc 80% so với cell (mặc định là 100%)
Những khả năng mở rộng chỉ là dạng Optional, nếu anh không thích dùng vẫn có thể bỏ qua không cần khai báo. Ví dụ anh chỉ muốn chèn hình vào cell B1, với đương dẫn nằm ở A1, vậy chỉ cần gõ vào B1 thế này là đủ: =CommPic(A1) mà không cần quan tâm những đối số phía sau

Vậy là điều ngày xưa thẩy bảo không làm được giờ đã không thành hiện thực rồi :-=

chuong10 · 29/1/16

Xin giúp đỡ vì cần add một lượng hình lớn nên file excel quá nặng, có cách nào để giảm dung lượng hình khi add vào excel hay phải giảm trước khi add vậy ?

KMV · 30/1/16

Tôi muốn đoạn VBA chèn hình ảnh bằng các ký tự vào trong cel: Ví dụ tôi điền chữ A vào ô nào đó thì hình "A.jpg" được tự động điền vào ô đó. bác nào cao thủ xin giúp đỡ, xin cảm ơn.

hdm.tp · 11/4/16

Em tải về fille ComPic nhưng tại sao khi em print preview thì lại không thấy ảnh

Mutants Men · 12/4/16

hdm.tp đã viết:
Em tải về fille ComPic nhưng tại sao khi em print preview thì lại không thấy ảnh

Mã:

[COLOR=#ff0000][B]        ActiveSheet.PageSetup.PrintComments = xlPrintInPlace[/B][/COLOR]
        With cmt.Shape
            .LockAspectRatio = msoFalse
            .Placement = xlMoveAndSize
            .Shadow.Visible = msoFalse
            .Line.ForeColor.RGB = PicCel.Interior.Color
            .AutoShapeType = msoShapeRectangle
            .Left = mRng.Left
            .Top = mRng.Top
            .Width = mRng.Width
            .Height = mRng.Height
            .ScaleWidth ScaleWidth, msoFalse, msoScaleFromMiddle
            .ScaleHeight ScaleHeight, msoFalse, msoScaleFromMiddle
            .Fill.UserPicture PicPath
        .PrintObject = True
        End With

thêm dòng màu đỏ đó thử xem

KhoiSMC · 18/4/16

Cám ơn thầy ndu96081631,

em đã in được ảnh nhờ hướng dẫn của thầy tại http://www.giaiphapexcel.com/forum/...nh-sách-và-insert-copy-đc&p=334774#post334774

cám ơn thầy nhiều,
Khoi

dauxom · 27/5/16

Chào thầy ndu96081631,
Thay vì chèn hình vào cell thì mình có code nào chèn hình vào ô vuông cho sẵn không?
Ví dụ trong hợp đồng, mình thay đổi mã nv hoặc tên thì hình trong ô vuông đó sẽ thay đổi theo.
Cám ơn thầy đã chia sẻ.

nvtnet · 5/7/16

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

quá tuyệt vời. trân thành cảm ơn bác

nvtnet · 5/7/16

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

thầy cho em hỏi có cách nào để ảnh ở một thư mục khác không (cho nó gọn)

ndu96081631 · 5/7/16

nvtnet đã viết:
thầy cho em hỏi có cách nào để ảnh ở một thư mục khác không (cho nó gọn)

Thư mục khác vẫn được mà bạn. Cứ gõ bằng tay đường dẫn thư mục vào rồi thí nghiệm xem

nvtnet · 13/7/16

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

Thầy cho em hỏi, hướng dẫn của thầy em áp dụng vào công việc rất ok nhưng có 1 vấn về trầm trọng, nếu khoảng 50 ảnh thì ok, nhưng khối lượng ảnh của em trên 1000 ảnh. khi em đư avof thư mục khoảng trên 150 ảnh thì file không thể chạy nhanh được, thường xuyên bị đóng đột ngột. em đã nén ảnh, giảm kích thước để mỗi ảnh chỉ khoảng 30 Kb tuy nhiên vẫn không giải quyết được. Mong thầy chỉ cách để khắc phục. cảm ơn thầy nhiều

langtuchungtinh360 · 13/7/16

nvtnet đã viết:
Thầy cho em hỏi, hướng dẫn của thầy em áp dụng vào công việc rất ok nhưng có 1 vấn về trầm trọng, nếu khoảng 50 ảnh thì ok, nhưng khối lượng ảnh của em trên 1000 ảnh. khi em đư avof thư mục khoảng trên 150 ảnh thì file không thể chạy nhanh được, thường xuyên bị đóng đột ngột. em đã nén ảnh, giảm kích thước để mỗi ảnh chỉ khoảng 30 Kb tuy nhiên vẫn không giải quyết được. Mong thầy chỉ cách để khắc phục. cảm ơn thầy nhiều

mình thấy là không còn cách nào khác đâu. nếu bạn chèn xong rồi thì tại ô bạn gõ công thức để chèn ảnh ấy. xóa công thức đi cho rồi.

nvtnet · 15/7/16

langtuchungtinh360 đã viết:
mình thấy là không còn cách nào khác đâu. nếu bạn chèn xong rồi thì tại ô bạn gõ công thức để chèn ảnh ấy. xóa công thức đi cho rồi.

mình cũng đang áp dụng cách này. tức là làm thêm một lẹnh nếu gõ số 0 thi chèn đường dẫn nào để hiện ảnh, nếu gõ 1 thì cho đường dẫn ảnh bằng rỗng, nhưng như vậy thì cũng như ko chèn nên mình xóa luôn cho đỡ nhọc. mong sao có cách cải thiện

canhld · 16/7/16

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

Hi, các bác cho em hỏi :
Bài toán của em là : có 1danh sách các nhân viên (mã nhân viên và tên nhân viên) ở sheet "danh sach" và ảnh các nhân viên được lưu theo mã nhân viên (G001, G002..... .*JPG). Muốn chèn ảnh nhân viên ở sheet "in anh" thì chỉ cần gõ mã nhân viên vào là tự nhảy tên,ảnh thì phải làm thế nào ạ?
Em xin cảm ơn!

phuongan_123 · 24/9/16

cảm ơn bài viết của bạn, nhưng bạn cho mình hỏi thêm một vấn đề thế này, mình không biết phải làm thế nào:
mình có một cái bàn, mình chụp hình từ khi còn trong bao bì, mở bao bì và chụp mọi góc nhìn của bàn, khoảng 5-7 tấm hình
rồi một cái tủ minh cũng chụp như thế cũng khoảng 10-11 tấm hình
vậy làm thế nào để lấy hình của bàn hay tủ thì tất cả đều hiện ra và theo thứ tự

phuongan_123 · 24/9/16

sao mình làm hoài mà k được, giúp mình với

phuongan_123 · 25/9/16

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

hihi, bạn có thể chỉ lại dể hiểu cho mình k, cái này mình làm mà k được
cảm ơn bạn nhiều

vietbom · 27/9/16

Bác có số điện thoại không cho e hỏi với ạ?. Em đọc như thế này nhưng vẫn chưa hiểu cách làm

hugewall · 19/10/16

Cảm ơn các bác đã chia sẻ. Em thấy ảnh chèn vào comment tự fit cả 2 chiều nên dẫn đến méo hình. Có cách nào lấy được tỉ lệ dài/rộng của file ảnh ngoài không ạ? nếu được ta set size của shape với tỉ lệ phù hợp sẽ rất đẹp. Trân trọng!

phuonghâui · 31/10/16

hic. mình thử đi thử lại rồi mà k làm được bạn ạ. không biết ntn nữa

luuhoangkiem · 5/11/16

hugewall đã viết:
Cảm ơn các bác đã chia sẻ. Em thấy ảnh chèn vào comment tự fit cả 2 chiều nên dẫn đến méo hình. Có cách nào lấy được tỉ lệ dài/rộng của file ảnh ngoài không ạ? nếu được ta set size của shape với tỉ lệ phù hợp sẽ rất đẹp. Trân trọng!

Fit pic mình nghiên cứu có thể tự fit ảnh theo tỉ lệ mà ko làm méo hình

http://www.giaiphapexcel.com/forum/showthread.php?120251-Nút-lệnh-tự-resize-ảnh-và-cố-định-ảnh-vào-ô

Hà Quang Dương · 19/11/16

Bác ơi in ra là mất ạ. Bác sửa giúp em cố định vào ô được không ạ. Em cảm ơn rất nhiều

langtuchungtinh360 · 2/1/17

ndu96081631 đã viết:
Thư mục khác vẫn được mà bạn. Cứ gõ bằng tay đường dẫn thư mục vào rồi thí nghiệm xem

thầy ạ, em có góp ý thế này.
ví dụ như tấm hình có kích thước là 300x600 thì khi dùng công thức nếu em chọn vùng chèn là 1 vùng có kích thước tương tự 1 hình vuông, thì khi đó vấn đề xảy ra là hình nó sẽ bị kéo dãn ra theo vùng chọn, hình sẽ bị méo mó không còn được như kích thước tỷ lệ ban đầu nữa. vậy có thể bổ xung thêm tính năng, chèn ảnh vào vùng đó nhưng vẫn giữ nguyên kích thước tỷ lệ của ảnh được không thầy.

ndu96081631 · 2/1/17

langtuchungtinh360 đã viết:
thầy ạ, em có góp ý thế này.
ví dụ như tấm hình có kích thước là 300x600 thì khi dùng công thức nếu em chọn vùng chèn là 1 vùng có kích thước tương tự 1 hình vuông, thì khi đó vấn đề xảy ra là hình nó sẽ bị kéo dãn ra theo vùng chọn, hình sẽ bị méo mó không còn được như kích thước tỷ lệ ban đầu nữa. vậy có thể bổ xung thêm tính năng, chèn ảnh vào vùng đó nhưng vẫn giữ nguyên kích thước tỷ lệ của ảnh được không thầy.

Nếu có nhu cầu thì bạn tự làm cũng được mà

langtuchungtinh360 · 2/1/17

ndu96081631 đã viết:
Nếu có nhu cầu thì bạn tự làm cũng được mà

trình độ em sao làm được thầy --=0

. cứ mỗi lần muốn cái gì là lục tung "gu gồ" mờ mắt luôn.

ndu96081631 · 3/1/17

langtuchungtinh360 đã viết:
trình độ em sao làm được thầy . cứ mỗi lần muốn cái gì là lục tung "gu gồ" mờ mắt luôn.

Bạn cứ đùa! Tôi thấy bạn thiết kế file tiến độ thi công hay quá trời luôn. Hàm bạn viết còn phức tạp chứ hàm chèn hình của tôi có gì đâu bạn

langtuchungtinh360 · 3/1/17

ndu96081631 đã viết:
Bạn cứ đùa! Tôi thấy bạn thiết kế file tiến độ thi công hay quá trời luôn. Hàm bạn viết còn phức tạp chứ hàm chèn hình của tôi có gì đâu bạn

vậy thầy chỉ em đoạn code lấy thông tin của file được chọn yk thầy. em tự sửa lại.
trước em tìm được đoạn code fso lấy toàn bộ thông tin của mọi tệp tin (nếu có) mà giờ lạc đâu mất rồi. nên không biết code lấy size ảnh (đối với trường hợp này) để chỉnh lại.

ndu96081631 · 3/1/17

langtuchungtinh360 đã viết:
vậy thầy chỉ em đoạn code lấy thông tin của file được chọn yk thầy. em tự sửa lại.
trước em tìm được đoạn code fso lấy toàn bộ thông tin của mọi tệp tin (nếu có) mà giờ lạc đâu mất rồi. nên không biết code lấy size ảnh (đối với trường hợp này) để chỉnh lại.

Thử hàm này xem:

Mã:

Function PicDimensions(ByVal FileName As String)
  On Error Resume Next
  Dim sName As String, sFolder As String
  Dim FSO As Object, oShel As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set oShel = CreateObject("Shell.Application")
  If FSO.FileExists(FileName) Then
    sFolder = FSO.GetFile(FileName).ParentFolder.Path
    sName = FSO.GetFile(FileName).Name
    With oShel.Namespace("" & sFolder & "")
      PicDimensions = .Getdetailsof(.ParseName("" & sName & ""), 31)
    End With
  End If
End Function

Code lấy kích thước của file hình

langtuchungtinh360 · 3/1/17

ndu96081631 đã viết:
Thử hàm này xem:

Code lấy kích thước của file hình

xong rồi thầy ạ, dân học tự nhiên mà dốt toán, ngồi một hồi mới nghĩ ra cách tính toán chỉnh hình lại

tnghiaba · 22/2/17

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

bài này rất hay cảm ơn thầy,
nhưng cho e hỏi sao trong file ví dụ của thầy e ấn đảo qua đảo được, ok.
nhưng e bỏ ảnh của e vào thì chạy ra một ô màu hồng ko thấy ảnh, em kiểm tra ảnh của thầy chỉ có 7kb , ảnh của em tối 200kb .
vậy làm sao để có thể bỏ được những ảnh như thế ah, cảm ơn thầy

BuiPhuongThuy · 2/3/17

Anh ơi em làm như anh hướng dẫn nhưng đến bước cuối cùng =CommPic(B5,C5) thì báo lỗi ạ. Các bước trên hiển thị giống như file anh gửi ạ

dinhphuong9327 · 10/4/17

Chào Thầy ndu và các A/E GPE

Sau khi xem các bài hướng dẫn trên em đã chèn được hình vào ô excel. Em muốn tạo thêm 01 sheet (hoặc 1 file excel khác) chỉ chứa nội dung thôi (hình ảnh nằm trong cell - không còn công thức nữa). Em đã thử copy và paste value, comment, formats, tuy nhiên hình ảnh không còn nằm trong cell nữa.

Rất mong nhận được hướng dẫn của thầy và mọi người

Em cảm ơn

langtuchungtinh360 · 10/4/17

dinhphuong9327 đã viết:
Chào Thầy ndu và các A/E GPE

Sau khi xem các bài hướng dẫn trên em đã chèn được hình vào ô excel. Em muốn tạo thêm 01 sheet (hoặc 1 file excel khác) chỉ chứa nội dung thôi (hình ảnh nằm trong cell - không còn công thức nữa). Em đã thử copy và paste value, comment, formats, tuy nhiên hình ảnh không còn nằm trong cell nữa.

Rất mong nhận được hướng dẫn của thầy và mọi người

Em cảm ơn

vậy bạn chưa hiểu cách hoạt động của nó rồi.
cách thức hoạt động của hàm là chèn chú thích comment vào nên bạn copy kiểu gì cũng chả theo được đâu
nếu sau khi bạn chèn ảnh xong rồi mà muốn giữ nguyên ảnh đó thì sau khi chèn xong bạn xóa công thức tại ô đó đi. lưu ý không xóa luôn ô chứa công thức nha, chỉ xóa công thức thôi, còn nếu bạn muốn vẫn còn công thức mà hình ảnh không mất thì có thể đặt điều kiện theo kiểu =if(true, chèn hình, không làm gì)
thích thì dùng code sau, tôi đã sửa vài chỗ để phù hợp với tôi thôi, bạn thích thì dùng, không thì cứ dùng code của thầy ndu

dinhphuong9327 · 11/4/17

Dạ cám ơn Anh langtuchungtinh360

Em đã giải quyết được vấn đề của em rồi ạ. Anh có thể hướng dẫn giúp em cách sử dụng hàm commpic của anh viết được không ạ. em vẫn sử dụng theo cách cũ là = commpic("đường dẫn tới file ảnh"&""&ô chứa tên ảnh&".JPG"). Phần định dạng ảnh .JPG......em vẫn nhập thủ công, em thấy trong code của anh đã giải quyết vấn đề này nhưng em không biết cách vận dụng.

Mong anh hướng dẫn. Cám ơn Anh

langtuchungtinh360 · 11/4/17

dinhphuong9327 đã viết:
Dạ cám ơn Anh langtuchungtinh360

Em đã giải quyết được vấn đề của em rồi ạ. Anh có thể hướng dẫn giúp em cách sử dụng hàm commpic của anh viết được không ạ. em vẫn sử dụng theo cách cũ là = commpic("đường dẫn tới file ảnh"&""&ô chứa tên ảnh&".JPG"). Phần định dạng ảnh .JPG......em vẫn nhập thủ công, em thấy trong code của anh đã giải quyết vấn đề này nhưng em không biết cách vận dụng.

Mong anh hướng dẫn. Cám ơn Anh

tại code đó tôi lười không nhớ hết được các định dạng ảnh nên để cho nó tự xử ấy mà.
+cụ thể là nếu bạn nhập đường dẫn cụ thể thì code sẽ lấy đường dẫn đó
+còn nếu định dạng file không đúng (không chèn được) thì sẽ sửa lại cho đúng rồi chèn vào.
+ code cũng kiểm tra đường dẫn bạn nhập có đúng không, nếu không tồn tại thì code sẽ kiểm tra trong thư mục Picture tại ổ C, nếu có file tên như thế thì sẽ chèn vào. không thì thôi không chèn
+vùng chèn ảnh không bắt buộc phải gộp lại tức là có thể chèn tại các ô rời rạc, chỉ cần chọn vùng là được
+đôi khi kích thước ảnh không phù hợp với tỷ lệ vùng chèn thì code cũng xử lý để chèn vào vừa đủ phạm vi bạn chèn vì vậy ảnh sẽ không bị sai kích thước, méo mó.
cách sử dụng thì cũng giống như cách gốc thôi, có điều chèn ảnh từ internet không được thôi (vì tôi không cần như thế)

nampq1969 · 14/4/17

Rất hữu ích. Cảm ơn rất nhiều.

Mutants Men · 26/7/17

sửa lại hàm của anh ndu và langtuchungtinh360 lại một chút
chèn ảnh thật vô luôn chứ không bằng ghi chú nữa (đỡ nhọc công vô chỉnh trong PageSetup để in)
hàm bỏ chức năng chèn ảnh theo link trên mạng

ndu96081631 · 26/7/17

Mutants Men đã viết:
sửa lại hàm của anh ndu và langtuchungtinh360 lại một chút
chèn ảnh thật vô luôn chứ không bằng ghi chú nữa (đỡ nhọc công vô chỉnh trong PageSetup để in)
hàm bỏ chức năng chèn ảnh theo link trên mạng

- Tại 1 cell nào đó, bạn gõ hàm =InsertPic("đường dẫn đến hình) ---> ra 1 tấm hình
- Xong bạn chọn tấm hình vừa chèn, đổi tên nó
- Chọn vào cell chứa hàm InsertPic rồi F2 và Enter ---> Ra thêm tấm hình nữa
- vân... vân...
Đâu phải tôi không biết cách chèn hình thật và cũng đâu phải ngẫu nhiên tôi lại chọn giải pháp là chèn hình vào comment

Mutants Men · 26/7/17

ndu96081631 đã viết:
- Tại 1 cell nào đó, bạn gõ hàm =InsertPic("đường dẫn đến hình) ---> ra 1 tấm hình
- Xong bạn chọn tấm hình vừa chèn, đổi tên nó
- Chọn vào cell chứa hàm InsertPic rồi F2 và Enter ---> Ra thêm tấm hình nữa
- vân... vân...
Đâu phải tôi không biết cách chèn hình thật và cũng đâu phải ngẫu nhiên tôi lại chọn giải pháp là chèn hình vào comment

em thấy cách chèn hình bằng comment cũng hay nhưng khi in ra lại phải chỉnh trong cài đặt mới in ra được, vừa rồi em vừa dính vấn đề đó. Ctrl P in ra bình thường, nhưng khi chạy code để in thì in không thấy ảnh. vì thế mới sửa lại bằng cách chèn ảnh vào luôn. cụ thể tại bài này #137

phuyen89 · 26/7/17

Mutants Men đã viết:
em thấy cách chèn hình bằng comment cũng hay nhưng khi in ra lại phải chỉnh trong cài đặt mới in ra được, vừa rồi em vừa dính vấn đề đó. Ctrl P in ra bình thường, nhưng khi chạy code để in thì in không thấy ảnh. vì thế mới sửa lại bằng cách chèn ảnh vào luôn. cụ thể tại bài này #137

Mình thây trong mục In có phần in Comment mà.

befaint · 26/7/17

phuyen89 đã viết:
Mình thây trong mục In có phần in Comment mà.

Đọc kỹ vấn đề họ diễn đạt đi... Họ nói là in bằng code thì không được.

phuyen89 · 26/7/17

befaint đã viết:
Đọc kỹ vấn đề họ diễn đạt đi... Họ nói là in bằng code thì không được.

Em thử như thế này, in ra máy ảo thì ổn.

Mã:

Sub PrintPre()
    Application.DisplayCommentIndicator = xlCommentAndIndicator
    ActiveSheet.PrintPreview
End Sub

befaint · 26/7/17

phuyen89 đã viết:
Em thử như thế này, in ra máy ảo thì ổn.

Mã:

Sub PrintPre() Application.DisplayCommentIndicator = xlCommentAndIndicator ActiveSheet.PrintPreview End Sub

Bạn thử code với hàm chèn hình vào cell đó, nếu mà được thì hay quá. Chứ code trên theo mình nghĩ người ta chắc cũng nghĩ tới.

ndu96081631 · 27/7/17

Mutants Men đã viết:
em thấy cách chèn hình bằng comment cũng hay nhưng khi in ra lại phải chỉnh trong cài đặt mới in ra được, vừa rồi em vừa dính vấn đề đó. Ctrl P in ra bình thường, nhưng khi chạy code để in thì in không thấy ảnh. vì thế mới sửa lại bằng cách chèn ảnh vào luôn. cụ thể tại bài này #137

Việc chỉnh Page Setup là chuyện mà người ngồi trên máy tính phải biết (in cái gì, in từ đâu đến đâu...)
Đặt trường hợp bạn định viết code để dành cho người không biết gì có thể dùng được mà không cần tinh chỉnh gì cả, bạn có thể viết 1 code làm công việc Page Setup kia là xong. Code có thể nằm trong sub AutOpen hoặc đặt trong sự kiện Workbook_BeforePrint, chẳng hạn:

Mã:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim wks As Worksheet
  Set wks = ActiveSheet
  wks.PageSetup.PrintComments = xlPrintInPlace
End Sub

Nói chung là tôi không gặp bất cứ vấn đề gì trong việc in ấn với comment cả (kể cả in bằng tay hay dùng code)

PacificPR · 27/7/17

Mutants Men đã viết:
em thấy cách chèn hình bằng comment cũng hay nhưng khi in ra lại phải chỉnh trong cài đặt mới in ra được, vừa rồi em vừa dính vấn đề đó. Ctrl P in ra bình thường, nhưng khi chạy code để in thì in không thấy ảnh. vì thế mới sửa lại bằng cách chèn ảnh vào luôn. cụ thể tại bài này #137

Em thấy anh cùng công ty với anh langtuchungtinh360 mà. Anh nhờ anh ấy giúp cho

Mutants Men · 27/7/17

ndu96081631 đã viết:
Việc chỉnh Page Setup là chuyện mà người ngồi trên máy tính phải biết (in cái gì, in từ đâu đến đâu...)
Đặt trường hợp bạn định viết code để dành cho người không biết gì có thể dùng được mà không cần tinh chỉnh gì cả, bạn có thể viết 1 code làm công việc Page Setup kia là xong. Code có thể nằm trong sub AutOpen hoặc đặt trong sự kiện Workbook_BeforePrint, chẳng hạn:

Mã:

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim wks As Worksheet Set wks = ActiveSheet wks.PageSetup.PrintComments = xlPrintInPlace End Sub

Nói chung là tôi không gặp bất cứ vấn đề gì trong việc in ấn với comment cả (kể cả in bằng tay hay dùng code)

vẫn không được anh ạ.
em đã dùng code để chọn danh sách sheet cần in
xong trước những dòng code để in đã cho code này vào

Mã:

  Dim wks As Worksheet
  Set wks = ActiveSheet
  wks.PageSetup.PrintComments = xlPrintInPlace

còn thêm dòng này nữa

Mã:

Application.DisplayCommentIndicator = xlCommentAndIndicator

in ra vẫn không hiện comment

Mutants Men · 27/7/17

PacificPR đã viết:
Em thấy anh cùng công ty với anh langtuchungtinh360 mà. Anh nhờ anh ấy giúp cho

anh ấy đi về nơi xa rồi bạn.

ndu96081631 · 27/7/17

Mutants Men đã viết:
vẫn không được anh ạ.
em đã dùng code để chọn danh sách sheet cần in
xong trước những dòng code để in đã cho code này vào

Mã:

Dim wks As Worksheet Set wks = ActiveSheet wks.PageSetup.PrintComments = xlPrintInPlace

còn thêm dòng này nữa

Mã:

Application.DisplayCommentIndicator = xlCommentAndIndicator

in ra vẫn không hiện comment

Code trên chỉ là gợi ý setup cho 1SHEET! Nếu in NHIỀU SHEET thì phải... LÀM SAO?

Mutants Men · 27/7/17

ndu96081631 đã viết:
Code trên chỉ là gợi ý setup cho 1SHEET! Nếu in NHIỀU SHEET thì phải... LÀM SAO?

Mã:

Arr = array("Sheet1","Sheet2","Sheet3","Sheet4")
Sheets(Arr).select
Set wks = ActiveSheet

rồi em dùng lệnh in. nhưng vẫn không in ra được comment
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

ndu96081631 · 27/7/17

Mutants Men đã viết:
Mã:

Arr = array("Sheet1","Sheet2","Sheet3","Sheet4") Sheets(Arr).select Set wks = ActiveSheet

rồi em dùng lệnh in. nhưng vẫn không in ra được comment
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

Trời đất ơi! Không phải bạn chứ?
Thấy bạn làm mấy file hoành tráng quá trời nên tôi không nghĩ ra lý do tại sao tình huống này có thể làm khó bạn được nhỉ?
Tôi đã nói rõ ràng:

ndu96081631 đã viết:
Code trên chỉ là gợi ý setup cho 1SHEET! Nếu in NHIỀU SHEET thì phải... LÀM SAO?

Vậy thì bạn phải nghĩ đến For... Next gì đó chứ!

Mã:

  Dim arr, sh As Object
  arr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
  Sheets(arr).Select
  For Each sh In ActiveWindow.SelectedSheets
    sh.PageSetup.PrintComments = xlPrintInPlace
  Next

Mutants Men · 27/7/17

ndu96081631 đã viết:
Trời đất ơi! Không phải bạn chứ?
Thấy bạn làm mấy file hoành tráng quá trời nên tôi không nghĩ ra lý do tại sao tình huống này có thể làm khó bạn được nhỉ?
Tôi đã nói rõ ràng:

Vậy thì bạn phải nghĩ đến For... Next gì đó chứ!

Mã:

Dim arr, sh As Object arr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") Sheets(arr).Select For Each sh In ActiveWindow.SelectedSheets sh.PageSetup.PrintComments = xlPrintInPlace Next

việc chỉnh để in được comment thì em đã chỉnh trước đó rồi, vào pagesetup vẫn thấy cài đặt in ghi chú như hiển thị, sau khi in vào lại pagesetup thì vẫn còn ở chế độ in ghi chú. nhưng trớ trêu thay khi in thì lại không thấy.
thầy qua trang này trả lời giúp em, chứ nói nãy giờ có vẻ đi xa chủ đề này mất rồi
em có viết gì đâu mà hoành tráng đâu thầy. mới tập tọe à.
vậy còn

Mã:

Sheets(arr).Select
'xong rồi dùng lệnh in 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
'hoặc xuất PDF: Save As PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=str_Path & TenFile

ngoài cách trên thì có cách nào tốt hơn để in 1 loạt danh sách sheet không thầy.
code trên là em ghi macro lại nên có vẻ chậm.
em thấy xuất PDF hình như có cách khác với Save As thành PDF thì phải

Mutants Men · 27/7/17

đây là dùng cách chèn ảnh như em viết bên trên (File PDF)

đây là chèn bằng comment (File PDF)

trên trang tính

mặc dù code đã chọn các sheet được in và có chỉnh lại để in ghi chú như thầy chỉ nhưng in vẫn không có ảnh

ndu96081631 · 27/7/17

Mutants Men đã viết:
đây là dùng cách chèn ảnh như em viết bên trên (File PDF)
View attachment 180498

đây là chèn bằng comment (File PDF)
View attachment 180499
trên trang tính
View attachment 180500

mặc dù code đã chọn các sheet được in và có chỉnh lại để in ghi chú như thầy chỉ nhưng in vẫn không có ảnh
View attachment 180502

Chết ngắt luôn! Bạn đã viết code thành 1 dự án lớn hẳn rồi. Xem code trong hình chụp thì thấy rằng phải sửa rất nhiều chỗ mới xong (bởi bạn áp code của tôi vào thấy.. trật lất)
----------------------
Cũng vì code của bạn đã trở thành DỰ ÁN LỚN nên mọi người đều rất ngại khi phải xem và sửa. Vì vậy, bạn "bí" chỗ nào, hỏi chỗ đó và chỉ nên đưa file + code vừa đủ (chứ đưa 1 "rừng" thế kia, không ai trả lời là đúng rồi)

Mutants Men · 27/7/17

ndu96081631 đã viết:
Chết ngắt luôn! Bạn đã viết code thành 1 dự án lớn hẳn rồi. Xem code trong hình chụp thì thấy rằng phải sửa rất nhiều chỗ mới xong (bởi bạn áp code của tôi vào thấy.. trật lất)
----------------------
Cũng vì code của bạn đã trở thành DỰ ÁN LỚN nên mọi người đều rất ngại khi phải xem và sửa. Vì vậy, bạn "bí" chỗ nào, hỏi chỗ đó và chỉ nên đưa file + code vừa đủ (chứ đưa 1 "rừng" thế kia, không ai trả lời là đúng rồi)

để em xem lại. có thể sai chỗ nào đó

Mã:

Sub Test()
Dim Arr As Variant
Arr = Array("BB_MTN", "TAB_SDD")
Sheets(Arr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\A.pdf"
End Sub

Thế này thì lại có ảnh
Ẹc.... Ẹc....

haunguyenth.1993 · 2/9/17

co the dung ham nay cho link tao bang ten khac ko
Vi du

ICFIT( B2) ,VOI B2= "OPEN FILE".
OPEN FILE DA DUOC TAO LINK
CAM ON NHIEU AK

lethuy.ducvinh · 16/10/17

anhtuan1066 đã viết:
Xưa nay người ta thường chèn hình vào bảng tính bằng 1 thủ tục nào đó (Sub...). Vậy các bạn có nghĩ rằng có thể chèn hình bằng hàm tự tạo không? Tức là ta gõ hàm vào cell, lập tức hình được chèn vào ngay cell ấy!
Ví dụ ta gõ thế này: =CommPic("D:\Pic\Hinh 1.jpg",C5) thì lập tức Hinh 1.jpg được chèn vừa vặn vào cell C5
Hấp dẫn nhỉ? Vậy mà code lại khá đơn giản:

Mã:

Function CommPic(Pic As String, Cel As Range) As String On Error Resume Next Application.Volatile Cel.Comment.Delete If Cel.Comment Is Nothing Then Cel.AddComment Cel.Comment.Text vbLf With Cel.Comment.Shape .Left = Cel.Left: .Top = Cel.Top: .Visible = True .Width = Cel.Width: .Height = Cel.Height .Fill.UserPicture Pic End With End Function

Thí nghiệm:
- Mở Excel, chèn code trên vào module, xong lưu file vào 1 thư mục nào đó
- Copy 1 số hình vào cùng thư mục chưa file Excel (file của tôi có 4 hình AT01.jpg, AT02.jpg, AT03.jpg và AT04.jpg)
- Gõ công thức này vào cell B3:

PHP:

=LEFT(CELL("filename",A1),FIND("[",CELL("filename",A1))-1)

- Từ cell A5 trở xuống, gõ tên các file hình
- Tại cell B5, gõ công thức =$B$3&A5 và kéo fill xuống
- Tại cell C5, gõ công thúc =CommPic(B5,C5) và kéo fill xuống
Xem thử hình đã được Add vào có ngoạn mục không?
Hy vọng tạo sự dễ dàng cho các bạn, những ai quan tâm đến việc chèn hình ảnh vào bảng tính

dear thầy,

File của em chèn hình vào ok đẹp nhưng in không thấy được hình, mong thầy xem giúp em

lethuy.ducvinh · 16/10/17

ndu96081631 đã viết:
Bạn đã hỏi ở bài 13 và cũng đã trả lời cho bạn tại bài 14 rồi còn gì! Không xem sao?

Bài 13, 14 xem ở đâu thầy. giúp em

befaint · 16/10/17

lethuy.ducvinh đã viết:
Bài 13, 14 xem ở đâu

anh79_ct · 1/1/18

Bài viết hay, nhưng có cách nào lấy hình ảnh khi các file ảnh nằm khác thư mục với file excel không vậy?
Mình có vài ngàn ảnh chi tiết chứa trên server nhưng muốn làm file excel này nằm ở thư mục khác. Mình muốn file excel này link với thư mục chứa hình ảnh đó.
Cám ơn chủ thớt nhé!

ndu96081631 · 2/1/18

anh79_ct đã viết:
Bài viết hay, nhưng có cách nào lấy hình ảnh khi các file ảnh nằm khác thư mục với file excel không vậy?
Mình có vài ngàn ảnh chi tiết chứa trên server nhưng muốn làm file excel này nằm ở thư mục khác. Mình muốn file excel này link với thư mục chứa hình ảnh đó.
Cám ơn chủ thớt nhé!

Hình nằm chỗ nào thì bạn cứ chỉ đường dẫn chính xác vào hàm là được chứ gì. Đâu có bắt buộc hình phải nằm trong thư mục chứa file Excel

anh79_ct · 2/1/18

Cám ơn anh nhiều nhé. Mình làm được rồi.
Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.
Dĩ nhiên các file pdf sẽ chứa trong cùng 1 thư mục nào đó trên server.
Xin lỗi nếu câu hỏi này không thuộc chuyên mục này nhé

.

befaint · 2/1/18

anh79_ct đã viết:
Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.

Từ khóa: Hyperlink

anh79_ct · 2/1/18

Wow, thật là ảo diệu

. Cám ơn bạn "befaint" nhé!

be_09 · 2/1/18

anh79_ct đã viết:
Cám ơn anh nhiều nhé. Mình làm được rồi.
Nhưng có câu này muốn mở rộng thêm chút là có cách nào làm tương tự với file pdf không. Ví dụ mình gõ mã số trùng tên file pdf vào một cell, rồi double click vào cell sẽ mở file pdf lưu sẵn trên 1 thư mục ở sever. Hoặc có thể tự động tạo link đến thư mục đó, để nhấn vào mở file pdf đó luôn.
Dĩ nhiên các file pdf sẽ chứa trong cùng 1 thư mục nào đó trên server.
Xin lỗi nếu câu hỏi này không thuộc chuyên mục này nhé .

Đương nhiên là được, nhưng hỏi ở đây thì lạc chủ đề, vào Link sau để tham khảo hoặc hỏi tiếp nhé.
http://www.giaiphapexcel.com/diendan/threads/tạo-hyper-link-cho-1-loạt-file-của-1-folder.81852/

ThaiDieuAnh · 4/1/18

Bây giờ em muốn chèn ảnh vào Textbox trên Form, rồi từ form mình xuất hình ảnh xuống cell được không ạ?

Hai Lúa Miền Tây · 4/1/18

ThaiDieuAnh đã viết:
Bây giờ em muốn chèn ảnh vào Textbox trên Form, rồi từ form mình xuất hình ảnh xuống cell được không ạ?

Ai mà đưa hình vào Textbox, người ta phải load hình vào Image control chứ bạn.

ThaiDieuAnh · 4/1/18

Hai Lúa Miền Tây đã viết:
Ai mà đưa hình vào Textbox, người ta phải load hình vào Image control chứ bạn.

Vâng ạ, nhờ bác sửa và thay Textbox bằng Image control giúp em được không ạ, cảm ơn bác

Hai Lúa Miền Tây · 4/1/18

ThaiDieuAnh đã viết:
Vâng ạ, nhờ bác sửa và thay Textbox bằng Image control giúp em được không ạ, cảm ơn bác

Dùng code như sau:

Mã:

 Image1.Picture = LoadPicture(DuongDanDenFileHinhAnh)

ThaiDieuAnh · 4/1/18

Hai Lúa Miền Tây đã viết:
Dùng code như sau:

Mã:

Image1.Picture = LoadPicture(DuongDanDenFileHinhAnh)

Xấu hổ quá, em thay các kiểu vẫn không hiển thị bác Hai Lúa Miền Tây ạ

ndu96081631 · 4/1/18

Tự dưng chèn hình vào form, rồi lại xuất xuống sheet? Không hiểu tại sao lại đi lòng vòng cho mệt thế không biết?

anh79_ct · 11/4/18

File download từ diễn đàn vẫn là .xls nhưng có thể chèn "Module". Nhưng sao khi mình tạo 1 Module trên file excel mới và chèn đoạn code này vào thì sau đó excel bắt save lại với macro (.xlsm) thì hàm này mới chạy được cho lần mở file tiếp theo, còn không thì chỉ dùng được cho lần mở hiện tại.

Nhưng nếu save với loại .xlsm thì file rất nặng. Có cách nào vẫn giữ loại .xlsx nhưng hàm trong Module vẫn có hiệu lực không?

befaint · 11/4/18

anh79_ct đã viết:
Có cách nào vẫn giữ loại .xlsx nhưng hàm trong Module vẫn có hiệu lực không?

1. Không
2. Thử *.xlsb
3. Add-Ins

anh79_ct · 14/4/18

Vậy sao file compic.xls (đuôi .xls)down trên diễn đàn về vẫn chạy được hàm trong module thế nhỉ?

ndu96081631 · 14/4/18

anh79_ct đã viết:
Vậy sao file compic.xls (đuôi .xls)down trên diễn đàn về vẫn chạy được hàm trong module thế nhỉ?

Thì có ai nói rằng đuôi xls không chạy được code đâu chứ
???
Chỉ đuôi xlsx mới không thể chứa code thôi. Vậy bạn đã biết rồi đấy, tính sao thì tùy

bjboyn00b · 11/6/18

File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô ( các phần phía trên mình không điều chỉnh được vì đã theo form biểu ) .
Mong được giúp đỡ

be_09 · 11/6/18

bjboyn00b đã viết:
File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô ( các phần phía trên mình không điều chỉnh được vì đã theo form biểu ) .
Mong được giúp đỡ

Nghĩ cũng ngộ, lấy dữ liệu ngay trong File bài 197 cho thuận tiện quản lý mà lại đi lấy dữ liệu từ File này FIXED ASSETS REGISTER-STANDARD1.xlsx

batman1 · 11/6/18

bjboyn00b đã viết:
File commpic rất hay nhưng mình đang gặp khó ở chỗ là ảnh mình muốn hiển thị sẽ là 1 vùng chứ không phải trong 1 ô

1. Với code dưới thì ảnh được nhập vĩnh viễn vào sheet. Khi mang tập tin sang máy khác thì không phải mang ảnh đi theo.
Với code

Mã:

.Fill.UserPicture Pic

thì khi xóa ảnh trên đĩa hoặc sang máy khác không có ảnh đó thì trên sheet sẽ rỗng. Cho tới cuối đời vẫn phải giữ ảnh trên đĩa. Nếu nhu cầu của bạn đúng là thế thì ngừng đọc tại đây và không dùng code. Vì code nhập ảnh vào sheet vĩnh viễn. Sau đó bạn có thể xóa ảnh trên đĩa hoặc mang sang máy khác.

2. Bạn có nhiều lựa chọn: nhập vào vùng 1 ô hoặc nhiều ô, nhập vừa khít với vùng, nhập Center trong vùng và nhập ảnh thực.

3. Thêm 1 Module (Atl+F11 -> Insert -> Module) và dán code dưới vào

Mã:

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
                Optional original As Boolean = False, Optional center 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
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("r" & Target.Row & "c" & Target.Column).Delete
    On Error GoTo 0
  
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    If fso.FileExists(PicFilename) Then
        Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
        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 = "r" & Target.Row & "c" & Target.Column
                shp.Placement = xlMoveAndSize
            End With
        End If
    End If
   
     Set fso = Nothing
End Sub

bjboyn00b · 18/6/18

batman1 đã viết:
1. Với code dưới thì ảnh được nhập vĩnh viễn vào sheet. Khi mang tập tin sang máy khác thì không phải mang ảnh đi theo.
Với code

Mã:

.Fill.UserPicture Pic

thì khi xóa ảnh trên đĩa hoặc sang máy khác không có ảnh đó thì trên sheet sẽ rỗng. Cho tới cuối đời vẫn phải giữ ảnh trên đĩa. Nếu nhu cầu của bạn đúng là thế thì ngừng đọc tại đây và không dùng code. Vì code nhập ảnh vào sheet vĩnh viễn. Sau đó bạn có thể xóa ảnh trên đĩa hoặc mang sang máy khác.

2. Bạn có nhiều lựa chọn: nhập vào vùng 1 ô hoặc nhiều ô, nhập vừa khít với vùng, nhập Center trong vùng và nhập ảnh thực.

3. Thêm 1 Module (Atl+F11 -> Insert -> Module) và dán code dưới vào

Mã:

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _ Optional original As Boolean = False, Optional center 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 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("r" & Target.Row & "c" & Target.Column).Delete On Error GoTo 0 Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(PicFilename) Then Set shp = .Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0) 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 = "r" & Target.Row & "c" & Target.Column shp.Placement = xlMoveAndSize End With End If End If Set fso = Nothing End Sub

Cảm ơn bác
Công việc của em là quản lý tài sản, cty có khoảng 10000 tài sản cố định, hàng tháng có khoảng trăm tài sản mua mới , mỗi tài sản có mã riêng, em định chụp ảnh về đặt tên ảnh là tên mã tài sản, sau đó dùng hàm để gọi thông tin tài sản, bao gồm cả ảnh ra trong file #197 , sau đấy in ra để lưu bản cứng mỗi tài sản 1 tờ , thế nên file của em không cần lưu ảnh vĩnh viễn, chỉ gọi ảnh của tài sản nào cần thôi bác.
Ví dụ như file em gửi thì mã tài sản ở ô B12 , còn ảnh sẽ hiện ở A23:F44

Chèn hình vào cell bằng hàm tự tạo (1 người xem)

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

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 mới

Thành viên tích cực

Thành viên tích cực

Cánh Diều xanh

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Cánh Diều xanh

Huyền thoại GPE

Cánh Diều xanh

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

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

Thành viên mới

Thành viên tích cực

Thành viên mới

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

Thành viên mới

File đính kèm

Thành viên mới

Huyền thoại GPE

Thành viên tích cực

Thành viên mớ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 thường trực

Thành viên mới

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

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

Huyền thoại GPE

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

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

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

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

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

Huyền thoại GPE

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

Huyền thoại GPE

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

Huyền thoại GPE

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

File đính kèm

Thành viên mới

Thành viên mới

Thành viên chính thức

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

File đính kèm

Thành viên chính thức

Thành viên đã dừng 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

Thành viên tích cực

|||||||||||||

Thành viên tích cực

|||||||||||||

Huyền thoại GPE

Thành viên mới