hoangdanhthang
Thành viên mới

- Tham gia
- 10/10/10
- Bài viết
- 2
- Được thích
- 0
Chào mọi người, mình có một việc sau cần sự giúp đỡ của mọi người. Hiện tại mình có một file excel chứa dữ liệu về thông tin của tất cả nhân viên trong công ty như: mã số nhân viên, họ tên, ngày sinh .v.v. và có một thư mục chứa ảnh của toàn bộ số nhân viên đó, ảnh đã được đặt tên theo mã số nhân viên. Việc mình phải làm bây giờ là nhập thông tin của từng nhân viên có kèm theo cả ảnh của người đó vào một file word theo form định sẵn của công ty. (mỗi nhận viên là một trang A4). Mình đã dùng phương pháp trộn thư trong word nhưng phần text thì dễ. còn phần ảnh chưa biết làm thế nào. Số nhân viên là hàng ngàn vì thế ngồi Inset từng cái một thì rất lâu. Trên cái form của file Word đó có 1 ô để chèn hình vào. Có ai biết cách chèn (trộn) hình hàng loạt từ thư mục chứa ảnh đó không ạ? Mình đã dùng một code của một bạn trên diễn đàn để chèn hình hàng loạt vào trong file dữ liệu Excel và đã làm được. Nhưng khi thực hiện trộn thư thì chỉ những cột thông tin (dạng text) là thể hiện được lên file word còn cột chứa hình ảnh thì nó không hiện ảnh lên trên file word được. Ai biết cách giải quyết giúp mình với! Mình đang cần rất gấp mình thật sự rất cảm ơn!. Đây là mail mình, nếu có thể mail cho mình thì tốt quá: hoangdanhthang@yahoo.com
Còn đây là code mà mọt bạn trên diễn đàn này đã làm để chèn ảnh tự động vào excel mà mình đã mượn dùng:
Sub Test1()
Dim PicFolder As String, Clls As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
With Application.FileDialog(4)
.Filters.Clear
.AllowMultiSelect = False
.Show
PicFolder = .SelectedItems(1)
End With
ActiveSheet.Pictures.Delete
For Each Clls In Range([C4], [C65536].End(xlUp))
PicName = PicFolder & "\" & Clls.Value & ".jpg"
ActiveSheet.Pictures.Insert(PicName).Name = Clls.Address
With ActiveSheet.Shapes(Clls.Address)
.LockAspectRatio = False
.Left = Clls.Offset(, -1).Left: .Top = Clls.Offset(, -1).Top
.Width = Clls.Offset(, -1).Width: .Height = Clls.Offset(, -1).Height
End With
Next Clls
Application.ScreenUpdating = True
End Sub
file test:
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=47607&d=1277195276
Còn đây là code mà mọt bạn trên diễn đàn này đã làm để chèn ảnh tự động vào excel mà mình đã mượn dùng:
Sub Test1()
Dim PicFolder As String, Clls As Range, PicName As String
Application.ScreenUpdating = False
On Error Resume Next
With Application.FileDialog(4)
.Filters.Clear
.AllowMultiSelect = False
.Show
PicFolder = .SelectedItems(1)
End With
ActiveSheet.Pictures.Delete
For Each Clls In Range([C4], [C65536].End(xlUp))
PicName = PicFolder & "\" & Clls.Value & ".jpg"
ActiveSheet.Pictures.Insert(PicName).Name = Clls.Address
With ActiveSheet.Shapes(Clls.Address)
.LockAspectRatio = False
.Left = Clls.Offset(, -1).Left: .Top = Clls.Offset(, -1).Top
.Width = Clls.Offset(, -1).Width: .Height = Clls.Offset(, -1).Height
End With
Next Clls
Application.ScreenUpdating = True
End Sub
file test:
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=47607&d=1277195276