PDA

View Full Version : Chèn hình ảnh tự động vào excel



ali3340tc
24-07-09, 09:12 AM
Xin chào tất cả các bạn

Tôi có một câu hỏi mong nhận được sự giải đáp của các bạn:

Trước đây tôi có 1 file excel gồm 2 sheet:
Sheet 1 là 1 form và cần phải điền nhiều thông tin
Sheet 2 chứa toàn bộ thông tin cần điền cho form của sheet 1.
Tôi đánh số thứ tự thông tin: 1, 2, 3..... Tại sheet 1 tôi dùng lệnh Vlookup để điền thông tin vào form. Và khi cần thông tin nào thì tôi chỉ việc đánh số thứ tự vào là xong.
Hiện nay, do phải cập nhật cả phần hình ảnh vào trong Form của sheet 1 nhưng tôi không biết có cách nào để đưa được ảnh vào 1 cách tự động mà ko phải insert từng cái 1. Ví dụ: Khi tôi đánh số thứ tự 1 vào thì thông tin và hình ảnh của data 1 sẽ hiển thị, khi đánh số 2 vào thì thông tin và hình ảnh của data 2 sẽ hiển thị.

Xin được cảm ơn

Hai Lúa Miền Tây
24-07-09, 09:14 AM
Bạn xem bài này nha

http://www.giaiphapexcel.com/forum/showpost.php?p=131046&postcount=6

Thân

ali3340tc
24-07-09, 10:47 AM
Cảm ơn các bạn

Tuy nhiên vì tôi cũng chưa hiểu hiều về code nên việc ứng dụng vào thực tế còn gặp nhiều khó khăn. Mong các bạn chỉ giúp cho đoạn mã. Tôi nhấn Alt+F11 nhưng cũng ko hiểu lắm, bạn nào có thể giải thích cho tôi được không?

Xin cảm ơn

Đây là file mà tôi đang cần chèn ảnh tự động vào. Do ko biết về code nên nhờ các bác cao thủ viết dùm. xin cảm ơn

ndu96081631
30-07-09, 07:00 PM
Đây là file mà tôi đang cần chèn ảnh tự động vào. Do ko biết về code nên nhờ các bác cao thủ viết dùm. xin cảm ơn
Data của bạn hỏng có 1 chữ nào, lấy gì mà làm hả bạn (thật thà ghê, ít ra cũng có vài dòng dử liệu chứ nhỉ)

ndu96081631
01-08-09, 08:28 AM
Đây là file mà tôi đang cần chèn ảnh tự động vào. Do ko biết về code nên nhờ các bác cao thủ viết dùm. xin cảm ơn
Có Data rồi thì dể làm thôi


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([R2], Target) Is Nothing Then
Set Rng = Sheet3.Range(Sheet3.[B1], Sheet3.[T65536].End(xlUp))
PicName = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 20)
Sheet1.Shapes(PicName).Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName)
.Name = PicName
.Left = [B12:L22].Left: .Top = [B12:L22].Top
.Width = [B12:L22].Width: .Height = [B12:L22].Height
End With
End If
End Sub
Tôi giả lập 26 tấm ảnh, bạn phải sửa lại cho phù hợp nha

ali3340tc
01-08-09, 08:57 AM
Tôi rất cảm ơn Bác ndu96081631 đã giúp đỡ. Tôi đã test thử và chạy rất tốt. Chỉ còn 1 điểm nhỏ là:
1- Bác có thể cho ảnh vào center hộ tôi được ko?
2- Khi load ảnh mới thì ảnh cũ ko bị del mà chỉ nằm dưới của ảnh mới.

Mong bác giúp đỡ tôi.

Xin cảm ơn

ndu96081631
01-08-09, 09:16 AM
Tôi rất cảm ơn Bác ndu96081631 đã giúp đỡ. Tôi đã test thử và chạy rất tốt. Chỉ còn 1 điểm nhỏ là:
1- Bác có thể cho ảnh vào center hộ tôi được ko?
2- Khi load ảnh mới thì ảnh cũ ko bị del mà chỉ nằm dưới của ảnh mới.

Mong bác giúp đỡ tôi.

Xin cảm ơn
Sorry... tôi sơ xuất!
- Bạn xóa mấy tấm ảnh (đã chèn) tại sheet Z7
- Tiếp theo bấm Alt + F11, thay đoạn:
Sheet1.Shapes(PicName).Delete
Thành:
ActiveSheet.Shapes("Pic").Delete
Thay:
.Name = PicName
Thành:
.Name = "Pic"
Thay:
[B12:L22]
Thành:
[B12:O22]

Hoặc chạy file mới này

kiencang76
19-01-10, 08:25 AM
Bạn xem bài này nha

http://www.giaiphapexcel.com/forum/showpost.php?p=131046&postcount=6

Thân
mình làm như bạn hướng dẫn, sao không thấy hình hiện lên**~**

dinhgiang.linh
02-04-10, 04:24 PM
Các bạn giúp mình với, hiện mình đang làm một file báo giá bằng excel cho công ty. Quản lý dựa trên mã sản phẩm. File excel có 2 sheet là DMSP với BaoGia. Yêu cầu như sau: Ở sheet BaoGia khi mình đánh vào Mã sản phẩm thì lần các thông tin ứng với mã đó xuất hiện kể cả hình ảnh ở Khung hình ảnh. Mình có tham khảo bài viết PicForm nhưng vẫn không làm sao cho hình xuất hiện ở khung hình ảnh được. Các Anh chị giúp mình với làm hộ Hoặc hướng dẫn mình làm với. Minh up file lên mediafile: http://www.mediafire.com/?kyejmnnzqdk (http://www.mediafire.com/?kyejmnnzqdk) mấy anh chị download về giúp mình nhé
Cảm ơn nhiều!

sealand
02-04-10, 05:05 PM
Mình làm rồi nhưng làm sao Load đây? Các bạn tải theo link dưới nhé
Nhớ giải nén ra ổ đĩa rồi hãy Test vì như vậy code mới tìm được tệp hình.
http://www.4shared.com/file/Zohjx6oI/Bao_gia.html
http://www.4shared.com/get/255257541/ed9488ee/Bao_gia.html

(http://www.4shared.com/file/255164297/6797e283/Bao_gia.html)

rosy84
02-04-10, 08:33 PM
Sorry... tôi sơ xuất!
- Bạn xóa mấy tấm ảnh (đã chèn) tại sheet Z7
- Tiếp theo bấm Alt + F11, thay đoạn:
Sheet1.Shapes(PicName).Delete
Thành:
ActiveSheet.Shapes("Pic").Delete
Thay:
.Name = PicName
Thành:
.Name = "Pic"
Thay:
[B12:L22]
Thành:
[B12:O22]

Hoặc chạy file mới này

Sheet1.Shapes(.Shapes(PicName).Delete

Câu lệnh này có ý nghĩa như thế nào vậy bác.

Mà sao khi em bỏ đi thì nó vẫn chạy bình thường.

ndu96081631
03-04-10, 08:58 AM
Sheet1.Shapes(.Shapes(PicName).Delete

Câu lệnh này có ý nghĩa như thế nào vậy bác.

Mà sao khi em bỏ đi thì nó vẫn chạy bình thường.
Ý đồ của tôi là: XÓA CÁI CŨ TRƯỚC MỚI CHÈN CÁI MỚI VÀO (nếu không thì chẳng bao lâu trên sheet sẽ có cả đóng hình nằm chồng lên nhau)
Có điều code ấy viết sai rồi, bạn phải lấy code tại bài số #7 mới đúng

dinhgiang.linh
13-05-10, 11:46 AM
Mình làm rồi nhưng làm sao Load đây? Các bạn tải theo link dưới nhé
Nhớ giải nén ra ổ đĩa rồi hãy Test vì như vậy code mới tìm được tệp hình.
http://www.4shared.com/file/255257541/ed9488ee/Bao_gia.html

(http://www.4shared.com/file/255164297/6797e283/Bao_gia.html)
Links hỏng rồi không download được bạn ơi. Thanks bạn

nghiaktkt
13-05-10, 12:54 PM
Link hỏng rồi pồ ơi, thanks

sealand
13-05-10, 02:42 PM
Mình bổ xung địa chỉ down file các bạn thông cảm
http://www.megaupload.com/?d=JT3N34FE

dinhgiang.linh
14-05-10, 11:29 AM
Mình bổ xung địa chỉ down file các bạn thông cảm
http://www.megaupload.com/?d=JT3N34FE
Mình down về rồi nhưng test không load ảnh lên được. Dù sao cũng cảm ơn bạn rất nhiều

sealand
14-05-10, 11:59 AM
Mình down về rồi nhưng test không load ảnh lên được. Dù sao cũng cảm ơn bạn rất nhiều

Chỉ có 2 lý do đối với trường hợp của bạn:
1/Bạn không giải nén ra ổ đĩa mà chạy trực tiếp từ WinRar nên không tìm thấy file hình ảnh.
2/Bạn chưa Enable Macro.

vchung
24-05-10, 12:31 PM
chào các anh.
em cần chèn ảnh từ sheet bệnh sang (ảnh đó cappy từ cad sang execll sang)
giúp em với nhé. %#^#$

tuananh89803
24-05-10, 04:37 PM
anh ndu96081631 cho em hỏi, em làm được rồi nhưng em ko biết VBA nên ko biết làm thế nào để nó tự chạy khi ô giá trị nó là 1, 2, 3,... (ví dụ như dùng hàm Vlookup để có giá trị 1, 2, 3...) và tương tự cho các ô tiếp thì phải làm sao anh? Vì Em đang làm phiếu xuất kho với mỗi sản phẩm nó tự ra hình ảnh của sản phẩm đó! Giúp em với, loay hoay cả ngày trời! hịc

hunggtg
08-10-10, 10:07 AM
Xin chào,

Nhờ các bạn giải giùm bài toán này nhé: http://www.giaiphapexcel.com/forum/showthread.php?41062-Chèn-ảnh-từ-website-vào-excel

0914389430
09-10-10, 12:21 AM
cho mình hỏi tét như nào bạn nhỉ.

0914389430
09-10-10, 12:51 PM
các bác oi em muon chèn nhieu anh tự động vao mot trang excel thi phải lam như nao vậy các bác chỉ em với.

Bảy Dzõ
08-03-11, 02:21 AM
Sorry... tôi sơ xuất!
- Bạn xóa mấy tấm ảnh (đã chèn) tại sheet Z7
- Tiếp theo bấm Alt + F11, thay đoạn:

Sheet1.Shapes(PicName).Delete
Thành:
ActiveSheet.Shapes("Pic").Delete
Thay:
.Name = PicName
Thành:
.Name = "Pic"
Thay:
[B12:L22]
Thành:
[B12:O22]

Hoặc chạy file mới này

Chào anh ndu,
Em thử áp dụng code của anh vào file của em mà không tài nào chạy được. Em thử đổi mọi các cũng ko được, kính mong anh và các cao thủ xem giúp giùm em (em muon hien thị hình trong ô màu vàng). File em gửi đính kèm theo.
Sẵn tiện cho phép em hỏi thêm, em dùng Office 2007 khi em lưu dạng .xlsx thì ko chạy macro được, em phải chuyển sang dạng .xlsm. Nhờ anh giải thích và chỉ dẫn giúp em để khắc phục tình trạng trên. Cám ơn anh rất nhiều

HOANG 1978
01-05-11, 10:52 AM
Cảm ơn các anh chị về code này nhưng có một điều là mã hình tôi phải gõ tay hoặc sử dụng consolidate thì mới lấy được hình còn như tôi dùng hàm "Vlookup" hay hàm "If" thì không hiển thị được hình mong các anh chi giúp cho

vitbau86
12-08-11, 11:57 AM
Mình bổ xung địa chỉ down file các bạn thông cảm
http://www.megaupload.com/?d=JT3N34FE
bác cho em hỏi, công thức trong các cell chứa ảnh là gì thế, em không xem được công thức, em gõ công thức Nfile sang cell khác nhưng ko load đc ảnh
. Bác bổ sung thêm code xử lý ảnh to nhỏ bằng đúng kích thước cell đc ko

ngobiencuong
05-01-12, 05:36 AM
Xin chào bác du96081631,
Em là thành viên mới, cũng như mới học excel mong bác chỉ bảo.
Cái chủ đề này đã được post lên lâu rùi nhưng em thấy rất hay và thích và muốn được học cái marco này. Nhưng mỗi tội excel vẫn kém nên chưa hiểu gì ^^.
Mong bác giúp đỡ có thể quay video lại từ đầu các bước bác làm được không ạ? cho em học lỏm tý?
Hy vọng nhận được phản hồi của bác sớm.
Em xin cảm ơn ạ.
Chúc bác năm mới vui vẻ và thành công.

ngobiencuong
08-01-12, 04:56 AM
Sorry... tôi sơ xuất!
- Bạn xóa mấy tấm ảnh (đã chèn) tại sheet Z7
- Tiếp theo bấm Alt + F11, thay đoạn:
Sheet1.Shapes(PicName).Delete
Thành:
ActiveSheet.Shapes("Pic").Delete
Thay:
.Name = PicName
Thành:
.Name = "Pic"
Thay:
[B12:L22]
Thành:
[B12:O22]


Hoặc chạy file mới này

Bác ndu96081631 ơi, em gửi câu hỏi nhưng chắc bác chưa đọc. Bác xem giúp em với. Cảm ơn bác nhiều ạ

NH_Duong
11-01-12, 10:44 PM
Xin chào bác ndu96081631
Mình có một câu hỏi mong nhận được sự giúp đỡ của bác. Mình có một Files dữ liệu gồm 2 Sheets là DS_VDV và IN_THE:
Mình muốn làm một cái Form in thẻ VĐV tự động theo thiết kế như Files (Đính kèm), Khi chạy Macro In the máy sẽ tự động lấy toàn bộ thông tin bên Sheet DS_VDV theo thứ tự sang Sheet IN_THE.
Mỗi bản in sẽ cho ra từ 4 - 6 thẻ. Tuy nhiên mình đang gặp khó khăn là làm sao để khi Hàm Loockup lấy Thông tin của các VĐV từ Sheet DS_VDV sang Sheet IN_THE thì ẢNH của VĐV đó cũng được tự động lấy sang và chèn đúng vừa khít vào vị trí như Hình số 2 để tạo ra trang in, sau khi in xong thì sẽ xóa ảnh đi để tải dữ liệu của VĐV khác vào và in tiếp.
Rất mong nhận được sự giúp đỡ của bác. Xin được cảm ơn.
NH_Duong.
Tel: 0975686368
Nick yahoo: sao_vang07

thaibinh_excel
25-11-12, 06:56 PM
Sorry... tôi sơ xuất!
- Bạn xóa mấy tấm ảnh (đã chèn) tại sheet Z7
- Tiếp theo bấm Alt + F11, thay đoạn:
Sheet1.Shapes(PicName).Delete
Thành:
ActiveSheet.Shapes("Pic").Delete
Thay:
.Name = PicName
Thành:
.Name = "Pic"
Thay:
[B12:L22]
Thành:
[B12:O22]


Hoặc chạy file mới này

Bác Ndu ơi, cho em hỏi, trong trường hợp em đổi tên file, k theo vị trí 1, 2, 3, 4 nữa là thành 1 cái mã số hình. Ví dụ như em có mã số tìm là 05006, em đặt tên hình là Pic05006.JPG, sao nó báo lỗi import ạ? Em k biết nó bị sai chỗ nào??Ngoài ra, nhờ bác giải thích giúp em dòng code này là để làm gì vậy ạ?
"PicName = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 20)"
Mong bác chỉ giúp! Cám ơn bác

pdtuk47
10-04-13, 10:38 AM
Chào các anh các chị hiện em đang thay đổi thẻ nhân viên, form cũ thường phải insert bằng tay rất lâu. Qua bác sỹ Google em tìm đến đây mong cả nhà giúp đỡ https://mail-attachment.googleusercontent.com/attachment/u/0/?ui=2&ik=6479d8c965&view=att&th=13df1feecc24a07d&attid=0.1&disp=safe&zw&saduie=AG9B_P-p66wM6lgpr7ESAM14WZDg&sadet=1365565759141&sads=LmuD5574-0nWu9WtW-oHKJcw2ps&sadssc=1
file của em như trên em đã thử edit code như bác ndu... rồi mà không chạy được :(

ndu96081631
10-04-13, 10:40 AM
Chào các anh các chị hiện em đang thay đổi thẻ nhân viên, form cũ thường phải insert bằng tay rất lâu. Qua bác sỹ Google em tìm đến đây mong cả nhà giúp đỡ https://mail-attachment.googleusercontent.com/attachment/u/0/?ui=2&ik=6479d8c965&view=att&th=13df1feecc24a07d&attid=0.1&disp=safe&zw&saduie=AG9B_P-p66wM6lgpr7ESAM14WZDg&sadet=1365565759141&sads=LmuD5574-0nWu9WtW-oHKJcw2ps&sadssc=1
file của em như trên em đã thử edit code như bác ndu... rồi mà không chạy được :(

Kết luận cuối cùng: FILE CỦA BẠN Ở ĐÂU?

pdtuk47
10-04-13, 11:00 AM
sr em lấy link từ email em gửi cho bác, em upload lại lên mediafire
http://www.mediafire.com/?658i1u3l8lk7zae

pdtuk47
10-04-13, 11:26 AM
sr em lấy link từ email em gửi cho bác, em upload lại lên mediafire
http://www.mediafire.com/?658i1u3l8lk7zae

pdtuk47
10-04-13, 11:27 AM
Kết luận cuối cùng: FILE CỦA BẠN Ở ĐÂU?
sr em lấy link từ email em gửi cho bác, em upload lại lên mediafire
http://www.mediafire.com/?658i1u3l8lk7zae

dhn46
10-04-13, 11:30 AM
sr em lấy link từ email em gửi cho bác, em upload lại lên mediafire
http://www.mediafire.com/?658i1u3l8lk7zae
Bạn có thể tham khảo Tiện tich in Form hang loạt. Link ngay trong chữ ký của tôi. Tiện ích này giúp bạn làm thẻ nhân viên mà bạn không cần biết lập trình, chỉnh sửa Code

ndu96081631
10-04-13, 01:16 PM
sr em lấy link từ email em gửi cho bác, em upload lại lên mediafire
http://www.mediafire.com/?658i1u3l8lk7zae

Sửa code của bạn thành vầy nhé:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, rPic As Range, FileName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([A4], Target) Is Nothing Then
ActiveSheet.Shapes("Pic").Delete
Set Rng = Sheet1.Range(Sheet1.[A1], Sheet1.[A45500].End(xlUp)).Resize(, 10)
Set rPic = Rng.Resize(, 1).Find(Target, , xlValues, xlWhole)
If Not rPic Is Nothing Then
FileName = ThisWorkbook.Path & "\" & rPic.Offset(, 6).Value
If CreateObject("Scripting.FileSystemObject").FileExists(FileName) Then
ActiveSheet.Pictures.Insert(FileName).Name = "Pic"
With ActiveSheet.Shapes("Pic")
.LockAspectRatio = False
.Left = [B2:C10].Left: .Top = [B2:C10].Top
.Width = [B2:C10].Width: .Height = [B2:C10].Height
End With
End If
End If
End If
Application.ScreenUpdating = True
End Sub

Lưu ý: Dòng code màu đỏ chỉ áp dụng cho Excel 2007 trở đi (nếu dùng Excel 2003 thì hãy xóa dòng màu đó ấy)

pdtuk47
10-04-13, 01:29 PM
Sửa code của bạn thành vầy nhé:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, rPic As Range, FileName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([A4], Target) Is Nothing Then
ActiveSheet.Shapes("Pic").Delete
Set Rng = Sheet1.Range(Sheet1.[A1], Sheet1.[A45500].End(xlUp)).Resize(, 10)
Set rPic = Rng.Resize(, 1).Find(Target, , xlValues, xlWhole)
If Not rPic Is Nothing Then
FileName = ThisWorkbook.Path & "\" & rPic.Offset(, 6).Value
If CreateObject("Scripting.FileSystemObject").FileExists(FileName) Then
ActiveSheet.Pictures.Insert(FileName).Name = "Pic"
With ActiveSheet.Shapes("Pic")
.LockAspectRatio = False
.Left = [B2:C10].Left: .Top = [B2:C10].Top
.Width = [B2:C10].Width: .Height = [B2:C10].Height
End With
End If
End If
End If
Application.ScreenUpdating = True
End Sub

Lưu ý: Dòng code màu đỏ chỉ áp dụng cho Excel 2007 trở đi (nếu dùng Excel 2003 thì hãy xóa dòng màu đó ấy)

Chào anh!
Xin phiền anh một chút nữa, code trên có thể giúp insert nhiều ảnh vào các ô trong cùng một trang không ? Em muốn làm thể tự động insert ảnh vào (vì là ảnh màu, mỗi thẻ chỉ nhỏ không thể in riêng mà tạo kín trang A4 khi đó đi in )
Em xin chân thành cảm ơn !

ndu96081631
10-04-13, 02:03 PM
Chào anh!
Xin phiền anh một chút nữa, code trên có thể giúp insert nhiều ảnh vào các ô trong cùng một trang không ? Em muốn làm thể tự động insert ảnh vào (vì là ảnh màu, mỗi thẻ chỉ nhỏ không thể in riêng mà tạo kín trang A4 khi đó đi in )
Em xin chân thành cảm ơn !

Vậy bạn thiết kế sẵn cái trang mà bạn muốn chèn hình cho tôi đi rồi tôi sẽ giúp
Còn không bạn tự tham khảo bài này:
http://www.giaiphapexcel.com/forum/showthread.php?51408-Ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o

pdtuk47
10-04-13, 02:40 PM
Vậy bạn thiết kế sẵn cái trang mà bạn muốn chèn hình cho tôi đi rồi tôi sẽ giúp
Còn không bạn tự tham khảo bài này:
http://www.giaiphapexcel.com/forum/showthread.php?51408-Ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o

Em định làm như thế này nhờ anh giúp em với, chỉ cần điền số thứ tự vào ô màu đỏ nó sẽ tự động insert dữ liệu và ảnh, phần dữ liệu thì em tự làm được còn phần ảnh thì khó quá. Mong nhận được sự giúp đỡ của anh
http://www.mediafire.com/?q67bq7xn8pa8cwl
Em xin chân thành cảm ơn!

ndu96081631
10-04-13, 04:04 PM
Em định làm như thế này nhờ anh giúp em với, chỉ cần điền số thứ tự vào ô màu đỏ nó sẽ tự động insert dữ liệu và ảnh, phần dữ liệu thì em tự làm được còn phần ảnh thì khó quá. Mong nhận được sự giúp đỡ của anh
http://www.mediafire.com/?q67bq7xn8pa8cwl
Em xin chân thành cảm ơn!

Chán bạn quá!
Bảo bạn thiết kế sẵn 1 trang tính đầy đủ mà bạn đưa lên cái gì đâu không
Tôi làm đại đây. Trúng trật ráng chịu

dhn46
10-04-13, 04:11 PM
Một cách cho bạn tham khảo

hieuxd
02-05-13, 10:35 AM
Nhờ các thầy và mọi người chỉ giúp cách chèn hình hình vẽ Autoshapes bên sheet: ThuVienHinh sang Sheet:ThongKe
Do thường xuyên chèn thêm hình nên em muốn chèn theo kiểu hàm Vlookup, Khi em nhập mã hiệu trùng với mã hiệu bên ThuVien thì hình bên sheet ThuVien được chèn qua cột bên cạnh của Sheet: ThongKe
Dùng hàm không giải quyết được các thầy và mọi người giúp em một hàm tự tạo bằng VBA với,
Em đang nghĩ dùng list trong Data validation nhưng vẫn nghĩ chưa ra

bbq1401
25-05-13, 11:59 AM
Gửi các anh trên diễn đàn giải pháp excel.
Em có 1 file in khuyến mại. Em đã làm VLOOKUP các thông tin rồi. Bây giờ em muốn chèn các ảnh vào sheets đó.
Các Anh giúp em với

hieuxd
04-07-13, 11:04 AM
Nhờ các thầy và mọi người chỉ giúp cách chèn hình hình vẽ Autoshapes bên sheet: ThuVienHinh sang Sheet:ThongKe
Do thường xuyên chèn thêm hình nên em muốn chèn theo kiểu hàm Vlookup, Khi em nhập mã hiệu trùng với mã hiệu bên ThuVien thì hình bên sheet ThuVien được chèn qua cột bên cạnh của Sheet: ThongKe
Dùng hàm không giải quyết được các thầy và mọi người giúp em một hàm tự tạo bằng VBA với,
Em đang nghĩ dùng list trong Data validation nhưng vẫn nghĩ chưa ra
Nhờ các thầy và anh chị xem giúp em vấn đề này với
Giờ em mới biết mình gửi nhầm Box
phải gửi sang Box VBA mới đúng

ntvuongq9
20-07-13, 06:52 PM
Mình có một file excel chèn hình băng VBA nhưng khi copy sang file khac để gửi mail mà người nhận không thể xem được hình trong file đó. Mong các sư phụ chỉ dẩn giup ah! 106098

dalat2010
26-07-13, 11:13 AM
Xin chào các bạn trên diễn đàn và bác ndu96081631.
Mình có câu hỏi mong nhận được sự giúp đỡ của các bạn. Mình làm như bác ndu96081631 hướng dẫn nhưng vẫn ko load hình được. Mình gửi kèm trang mẫu. Vì hình ảnh của mình rất năng nên không gửi lên đước. Tất cả hình ảnh trong các thư mục đặt theo thứ tự từ 1-40. Các bạn giúp giùm mình khi chép file excel này vào thư mục thì nó tự động load toàn bộ hình vào excel. và khi đưa file excel vào thư mục hình ảnh khác thì nó cũng tự động lấy như vậy. Cảm ơn các bạn rất nhiều.

nguoimayman2003
13-09-13, 02:28 PM
Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar

ndu96081631
13-09-13, 02:32 PM
Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar

Bạn xem bài viết này là tự nhiên biết cách làm liền:
http://www.giaiphapexcel.com/forum/showthread.php?51408-Ch%C3%A8n-h%C3%ACnh-v%C3%A0o-cell-b%E1%BA%B1ng-h%C3%A0m-t%E1%BB%B1-t%E1%BA%A1o

dalat2010
25-09-13, 02:07 PM
Bác ndu96081631 và các bạn giúp mình với, thử nhiều lần vẫn không đưa được hình ảnh vào .

dhn46
25-09-13, 06:14 PM
Các anh ơi, giúp em cái này với, em cũng đọc quá trời bài nhưng cuối cùng cũng không làm được, các anh giúp đỡ với. em có đính kèm file của em, các anh giúp đính lệnh vào thử một ô mẫu dùm em nha.
http://www.mediafire.com/download/3oj0zj6e4wx3j76/can_giup.rar
Bạn tham khảo tiện ích In Form hàng loạt, link tại chữ ký của tôi

Đây là file của bạn

hoangvu330
12-10-13, 03:22 PM
Có Data rồi thì dể làm thôi


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([R2], Target) Is Nothing Then
Set Rng = Sheet3.Range(Sheet3.[B1], Sheet3.[T65536].End(xlUp))
PicName = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 20)
Sheet1.Shapes(PicName).Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName)
.Name = PicName
.Left = [B12:L22].Left: .Top = [B12:L22].Top
.Width = [B12:L22].Width: .Height = [B12:L22].Height
End With
End If
End Sub
Tôi giả lập 26 tấm ảnh, bạn phải sửa lại cho phù hợp nha
anh ơi cho em hỏi thử:
Em có nhiều mã hàng ,mỗi mã có hình ảnh khác nhau.Vậy trong 1 sheet liệt kê nhiều mã hàng,khi mình đánh mã hàng nào vào thì sẽ hiện ra hình ảnh của mã hàng đó ở cột bên cạnh đc ko anh

ndu96081631
12-10-13, 04:06 PM
anh ơi cho em hỏi thử:
Em có nhiều mã hàng ,mỗi mã có hình ảnh khác nhau.Vậy trong 1 sheet liệt kê nhiều mã hàng,khi mình đánh mã hàng nào vào thì sẽ hiện ra hình ảnh của mã hàng đó ở cột bên cạnh đc ko anh

Tùy theo dữ liệu mà sửa code cho phù hợp chứ
Dùng cái này:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect(Range("A6:A100"), Target) Is Nothing Then
If Target.Count = 1 Then
PicName = Target.Address(0, 0)
ActiveSheet.Pictures(PicName).Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
.ShapeRange.LockAspectRatio = False
.Name = PicName
.Left = Target.Offset(, 3).Left: .Top = Target.Offset(, 3).Top
.Width = Target.Offset(, 3).Width: .Height = Target.Offset(, 3).Height
End With
End If
End If
End Sub

Kh Biet
12-10-13, 10:22 PM
Tùy theo dữ liệu mà sửa code cho phù hợp chứ
Dùng cái này:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect(Range("A6:A100"), Target) Is Nothing Then
If Target.Count = 1 Then
PicName = Target.Address(0, 0)
ActiveSheet.Pictures(PicName).Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
.ShapeRange.LockAspectRatio = False
.Name = PicName
.Left = Target.Offset(, 3).Left: .Top = Target.Offset(, 3).Top
.Width = Target.Offset(, 3).Width: .Height = Target.Offset(, 3).Height
End With
End If
End If
End Sub
Thày cho hỏi : Liệu thày có thể viết code để phóng to ảnh khi kích chuột và trở lại bình thường khi di chuyển chuột ra khỏi ảnh không ạ ?

ndu96081631
13-10-13, 05:54 AM
Thày cho hỏi : Liệu thày có thể viết code để phóng to ảnh khi kích chuột và trở lại bình thường khi di chuyển chuột ra khỏi ảnh không ạ ?

Ủa! Cái này đã làm mấy hôm trước rồi mà! Bài 105:
http://www.giaiphapexcel.com/forum/showthread.php?3721-Th%C3%AAm-1-d%E1%BA%A1ng-PicForm&p=536728#post536728

Kh Biet
13-10-13, 06:23 AM
Ủa! Cái này đã làm mấy hôm trước rồi mà! Bài 105:
http://www.giaiphapexcel.com/forum/showthread.php?3721-Th%C3%AAm-1-d%E1%BA%A1ng-PicForm&p=536728#post536728
Dạ, vì 2 cách load ảnh khác nhau, ở trang trên load ảnh toàn bộ folder, ở trang này load ảnh theo từng tên nhất định ạ ? sửa từ link trên phóng ảnh theo bài này khó quá, nó không chạy ạ !

kennis
20-03-14, 04:38 PM
Da thua anh, Vi sao khi in ra hinh anh lai ko hien duoc len vay anh? Em co 1 VBA nay nhung ko biet chay nhu the nao anh co the giai thich va chi giup em, sau khi cai dat VBA nay thi em nen dung cong thuc nao de chay duoc khong ah? Em cam on anh

Function LOT_PIC_PAC(LOT As String, DESTINATION_CELLS As Range, Optional PIC_BORDER As Boolean, Optional PIC_SHADOW As Boolean, Optional ENFORCE_SIZE As Boolean)
LOT_PIC_PAC = "Pic " & LOT

On Error GoTo SKIPIF
If DESTINATION_CELLS.Parent.Shapes(DESTINATION_CELLS. Address).AlternativeText = LOT Then Exit Function
DESTINATION_CELLS.Parent.Shapes(DESTINATION_CELLS. Address).Delete
SKIPIF:


Dim LFT As Double, TP As Double, WDTH As Double, HGT As Double, PIC As Object, i%
Dim FILEPATH(0 To 7) As String, PIC_NAME$
On Error GoTo 0
On Error GoTo EndIt
If LOT <> "0" Then
LFT = DESTINATION_CELLS.Left
TP = DESTINATION_CELLS.Top
WDTH = DESTINATION_CELLS.Width * 0.98
If DESTINATION_CELLS.Rows.Count > 1 Then WDTH = WorksheetFunction.Min(WDTH, DESTINATION_CELLS.Height / 1.41)
HGT = WDTH * 1.41
If ENFORCE_SIZE = True Then
WDTH = DESTINATION_CELLS.Width * 0.98
HGT = DESTINATION_CELLS.Height
End If
FILEPATH(0) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\ NoPicture.JPG"
If VBA.Environ("Username") = "Hoang Oanh" Then

FILEPATH(1) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"

Else

FILEPATH(1) = "\\OANH-PC\ D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
End If
FILEPATH(2) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(3) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(4) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(5) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(6) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"
FILEPATH(7) = "\\OANH-PC\D:\Oanh Vo\1a.Payless\13.Shipment\Tracking List\"

For i = 1 To UBound(FILEPATH, 1)
If VBA.IsNumeric(LOT) = True Then
PIC_NAME = Dir(FILEPATH(i) & Format(LOT, "000000") & "*")
Else
PIC_NAME = Dir(FILEPATH(i) & LOT & "*")
End If
If PIC_NAME <> "" Then
FILEPATH(0) = FILEPATH(i) & PIC_NAME
Exit For
End If
PIC_NAME = Dir(FILEPATH(i) & LOT & "*")
If PIC_NAME <> "" Then
FILEPATH(0) = FILEPATH(i) & PIC_NAME
Exit For
End If
If i = UBound(FILEPATH, 1) Then LOT_PIC_PAC = "Pic " & LOT & " not found"
Next i
On Error GoTo EndIt
If VBA.Right(FILEPATH(0), 4) = ".xls" Then GoTo EndIt
Set PIC = DESTINATION_CELLS.Parent.Shapes.AddPicture(FILEPAT H(0), False, True, LFT, TP, WDTH, HGT)
PIC.Name = DESTINATION_CELLS.Address
PIC.AlternativeText = LOT
If PIC_BORDER = True Then PIC.DrawingObject.ShapeRange.Line.DashStyle = msoLineSolid
If PIC_SHADOW = True Then PIC.Shadow.Visible = True
End If
EndIt:
On Error GoTo 0
End Function