Viết Macro để chèn, điều chỉnh kích cỡ bức tranh từ file tranh vào Word (1 người xem)

[hngiatuong]

Giả sử em có 20 file tranh được đánh số từ 1 đến 20 (tên file có thể là ký tự chữ), được lưu tại 1 thư mục D:\CMN chẳng hạn. Em muốn: bằng cách nào đó, như viết 1 macro chẳng hạn để khi ấn vào nút chèn nó sẽ tự khởi động Word sau đó chèn các file tranh lần lượt và theo thứ tự đã được đánh số thành 2 cột. Mỗi cột 2 file tranh, sao cho file 1 và file 2 phải được trên cùng 1 cột; tương tự cho file 3 và file 4, v.v ... Mục đích của yêu cầu này là định dạng giấy A4 và in ngang (tiết kiệm giấy), sau khi in sẽ được cắt đôi thành giấy A5 (nếu định dạng in giấy B5 hoặc A5 thì không cần tạo cột, mỗi trang 2 file ảnh. Nếu ảnh của bức tranh lớn hơn bình thường thì bị co lại theo quy định (có 2 ô trong bảng Excell nhận giá trị kích cỡ bức tranh). Cuối cùng là lưu vào D:\CMN.
Nói cách khác: Em có 1 số file tranh em muốn biên tập thành file Word dưới dạng 2 file theo thứ tự trên 1 trang giấy để in ra. File tranh làm VD xin các A/C copy vài file nào đógiúp, em không đưa lên sợ nặng diễn đàn.
Các Anh Chị trong diễn đàn ai có ý tưởng gì xin làm ơn chia sẻ và giúp đỡ. Em cảm ơn các A/C.

 

[hngiatuong]

Thật xin lỗi các A/C diễn đàn. Bây giờ em mới nghĩ ra là không nhất thiết phải chèn vào Word mà chèn ngay vào Excel cũng được. Miễn là sao tự động điều chỉnh kích thước theo yêu cầu. Thật vô cùng cảm ơn các A/C đã đọc bài viết của em. Và mong sớm nhận được sự giúp đỡ từ phía các A/C.

 

[kuldokk]

Thật xin lỗi các A/C diễn đàn. Bây giờ em mới nghĩ ra là không nhất thiết phải chèn vào Word mà chèn ngay vào Excel cũng được. Miễn là sao tự động điều chỉnh kích thước theo yêu cầu. Thật vô cùng cảm ơn các A/C đã đọc bài viết của em. Và mong sớm nhận được sự giúp đỡ từ phía các A/C.

Đây là 1 cách, bác tự lấy tranh cho vào nhé. chi tiết comment ở trong các cell A11

Sub test()
    Dim FilesToOpen As Variant
    Dim i As Integer, j As Integer, count As Integer
    Dim numberOfPicsPerRow As Integer, numberOfPics As Integer, numberOfRows As Integer
    Dim picWidth As Double, picHeight As Double, gap As Double
    
    FilesToOpen = Application.GetOpenFilename(Title:="Chon file anh", MultiSelect:=True)
    On Error GoTo KhongFileNaoDuocChon
    
    numberOfPics = UBound(FilesToOpen)
    numberOfPicPerRow = [A1]
    numberOfRows = WorksheetFunction.Ceiling(numberOfPics / numberOfPicPerRow, 1)
    
    picWidth = [B1]
    picHeight = [C1]
    gap = [D1]
    count = 1
    
    For i = 1 To numberOfRows
        For j = 1 To numberOfPicPerRow
                If count <= numberOfPics Then
                    With ActiveSheet.Pictures.Insert(FilesToOpen(count))
                        With .ShapeRange
                            .LockAspectRatio = msoTrue
                            .Width = picWidth
                            .Height = picHeight
                        End With
                        .Left = gap * j + picWidth * (j - 1)
                        .Top = gap * i + picHeight * (i - 1)
                        .Placement = 1
                        .PrintObject = True
                    End With
                End If
                count = count + 1
        Next j
    Next i
KhongFileNaoDuocChon:
    Exit Sub
End Sub

 

[hngiatuong]

Cảm ơn Anh đã giúp, nhưng sao: sau khi chèn thì tranh cuối cùng lại đi với tranh đầu tiên là 1 cặp (tranh cuối cùng lên vị trí đầu tiên). Như vậy thì tranh cuối cùng và tranh đầu tiên sẽ trên 1 cột, tương tự như vậy thì tranh 2 và tranh 3 sẽ trên 1 cặp, trong khi đó em muốn tranh 1 (tranh đầu tiên) và tranh thứ 2 sẽ trên 1 cột, tranh 3 và tranh 4 trên 1 cột, như vậy là hiện đang bị lệch. Hơn nữa là sau khi chèn (2 cột) thì tranh 1 và tranh 2 lại dàn theo chiều ngang trong khi đó em muốn xếp theo chiều cột dọc (để sau in ra giấy A4, sẽ cắt đôi thành giấy A5). Ngoài ra em muốn đưa thêm tên file tranh đó xuống phía dưới (chân bức tranh) và bên ngoài bức tranh để chú thích cho bức tranh. Trong diễn đàn có 1 vài bài như vậy nhưng em xem và chưa hiểu nên chưa vận dụng được. Anh xem lại giúp, cảm ơn anh nhiều.

 

[hngiatuong]

Có A/C nào có cách gì xin chỉ giúp. Em muốn chỉnh sửa code trên để khi chèn tranh vào, thì chèn luôn cả tên của file đó xuống dưới đáy bức tranh mô tả cho bức tranh. Và nếu chỉnh sửa được để chèn tranh được theo kiểu cột báo chí thì tốt. Xin cảm ơn.

 

[dhn46]

Bạn tham khảo link sau, tôi nghĩ sẽ đáp ứng yêu cầu của bạn

http://www.giaiphapexcel.com/forum/...ch-In-hàng-loạt-với-dữ-liệu-có-sẵn-trên-Excel