Insert nhiều ảnh vào Table trong Powpoint sử dụng VBA

ahungnv1992 · 8/2/22

Mục đích của em là sử dụng VBA insert nhiều ảnh vào Table trong Powpoint.
(Cụ thể file ảnh của em có 15 ảnh đánh số từ 1-15 sẽ được ghép tương ứng vào trong Table 1-5 như File đính kèm ạ)
Việc thao tác trên excel em đã thực hiện được.
Tuy nhiên việc sử dụng VBA đối với Powpoint em đã tham khảo nhiều bài viết từ nguồn nước ngoài vẫn không hiệu quả.
Vậy em mong các anh chị trong diễn đàn giúp đỡ em !
Năm mới kính chúc các anh chị trong diễn đàn thật nhiều Sức Khỏe , An Khang Thịnh Vượng .

huhumalu · 8/2/22

Đánh liều thử một phen vậy.
Bạn xem file đính kèm.

ahungnv1992 · 9/2/22

huhumalu đã viết:
Đánh liều thử một phen vậy.
Bạn xem file đính kèm.

Cảm ơn anh em đã hiểu! :clap2:

ahungnv1992 · 9/2/22

huhumalu đã viết:
Đánh liều thử một phen vậy.
Bạn xem file đính kèm.

Anh ơi, Ảnh có thể thay đổi kích thước tự động Theo Table khi Table thay đổi kích thước không ạ?

huhumalu · 9/2/22

ahungnv1992 đã viết:
Anh ơi, Ảnh có thể thay đổi kích thước tự động Theo Table khi Table thay đổi kích thước không ạ?

Chắc được.
Hình được định vị theo kích thước table.

ahungnv1992 · 9/2/22

huhumalu đã viết:
Chắc được.
Hình được định vị theo kích thước table.

Em cảm ơn anh nhiều ạ.

ahungnv1992 · 9/2/22

huhumalu đã viết:
Chắc được.
Hình được định vị theo kích thước table.

Hiện Excel em có thực hiện insert ảnh tối ưu tiết kiệm thời gian như video.Mong anh giúp đỡ em hoàn thiện code tương đương đối với Powpoint ạ.

batman1 · 9/2/22

Do bạn không nói rõ nên tôi giả thiết như sau.

Ảnh luôn được chèn vào bảng theo thứ tự nhất định: xuất phát từ dòng có ảnh thứ 1, cột thứ 1 và đi tới cột cuối cùng dòng rồi nhẩy sang dòng tiếp theo có ảnh. Code sẽ chèn ảnh theo thứ tự được chọn. Tức nếu chọn theo thứ tự 15.jpg, 1.jpg, 2.jpg, ..., 14.jpg (thứ tự chọn có thể thực hiện bằng cách vd. giữ phím Ctrl rồi click từng ảnh) thì 15.jpg sẽ được chèn vào dòng 1 cột 1 có ảnh, 1.jpg sẽ được chèn vào dòng 1 cột 2 có ảnh.

Không cần chọn cell nào trước khi chọn ảnh. Code sẽ chèn các ảnh được chọn vào TABLE theo thứ tự nói ở trên.

Nếu chọn ít hơn số cell thì những cell cuối không có ảnh. Nếu chọn nhiều hơn số cell thì những ảnh cuối không được chèn ở bất cứ chỗ nào.

Nếu ngoài JPG còn nhiều định dạng được dùng thì thêm vào code vào FILTERS.

Code bên PP

Mã:

Sub chen_anh()
Dim r As Long, c As Long, k As Long, count As Long, filename As String, tabl As Table, slideObj As Slide, fd As FileDialog, shp As Shape
    If ActivePresentation.Slides.count = 0 Then Exit Sub
    Set slideObj = ActivePresentation.Slides(1)
    If slideObj.Shapes.count = 0 Then Exit Sub
    If slideObj.Shapes(1).HasTable = 0 Then Exit Sub
    Set tabl = slideObj.Shapes(1).Table

    Set fd = Application.FileDialog(msoFileDialogOpen)

    With fd
        .AllowMultiSelect = True
        .Filters.Add "Images", "*.jpg; *.jpeg"
        If .Show <> -1 Then Exit Sub
    End With
    r = 2
    c = 1
    If tabl.Rows.count * tabl.Columns.count < fd.SelectedItems.count Then
        count = tabl.Rows.count * tabl.Columns.count
    Else
        count = fd.SelectedItems.count
    End If
    For k = 1 To count
        filename = fd.SelectedItems(k)
        Set shp = tabl.Cell(r, c).Shape
        slideObj.Shapes.AddPicture filename, msoCTrue, msoFalse, shp.Left, shp.Top, shp.Width, shp.Height
        c = (c Mod tabl.Columns.count) + 1
        If c = 1 Then r = r + 2
    Next
End Sub

huhumalu · 9/2/22

PW em lên mò đại.
Shape có lấy được item table hay quá ạ.
Đúng là anh ra tay thấy khác ngay

batman1 · 9/2/22

Có chút nhầm lẫn ở bài #8. Chỉ có 1/2 số cell để nhập ảnh, còn 1/2 số cell chứa Tiêu đề.

Sửa thành

If tabl.Rows.count * tabl.Columns.count / 2 < fd.SelectedItems.count Then
count = tabl.Rows.count * tabl.Columns.count / 2
Else
count = fd.SelectedItems.count
End If

/2 là mới thêm vào.

ahungnv1992 · 10/2/22

batman1 đã viết:
Có chút nhầm lẫn ở bài #8. Chỉ có 1/2 số cell để nhập ảnh, còn 1/2 số cell chứa Tiêu đề.

Sửa thành

/2 là mới thêm vào.

Em xin cảm ơn anh Batman1 nhiều ạ!

mickey1485 · 10/2/22

batman1 đã viết:
Do bạn không nói rõ nên tôi giả thiết như sau.

Ảnh luôn được chèn vào bảng theo thứ tự nhất định: xuất phát từ dòng có ảnh thứ 1, cột thứ 1 và đi tới cột cuối cùng dòng rồi nhẩy sang dòng tiếp theo có ảnh. Code sẽ chèn ảnh theo thứ tự được chọn. Tức nếu chọn theo thứ tự 15.jpg, 1.jpg, 2.jpg, ..., 14.jpg (thứ tự chọn có thể thực hiện bằng cách vd. giữ phím Ctrl rồi click từng ảnh) thì 15.jpg sẽ được chèn vào dòng 1 cột 1 có ảnh, 1.jpg sẽ được chèn vào dòng 1 cột 2 có ảnh.

Không cần chọn cell nào trước khi chọn ảnh. Code sẽ chèn các ảnh được chọn vào TABLE theo thứ tự nói ở trên.

Nếu chọn ít hơn số cell thì những cell cuối không có ảnh. Nếu chọn nhiều hơn số cell thì những ảnh cuối không được chèn ở bất cứ chỗ nào.

Nếu ngoài JPG còn nhiều định dạng được dùng thì thêm vào code vào FILTERS.

Code bên PP

Mã:

Sub chen_anh() Dim r As Long, c As Long, k As Long, count As Long, filename As String, tabl As Table, slideObj As Slide, fd As FileDialog, shp As Shape If ActivePresentation.Slides.count = 0 Then Exit Sub Set slideObj = ActivePresentation.Slides(1) If slideObj.Shapes.count = 0 Then Exit Sub If slideObj.Shapes(1).HasTable = 0 Then Exit Sub Set tabl = slideObj.Shapes(1).Table Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Images", "*.jpg; *.jpeg" If .Show <> -1 Then Exit Sub End With r = 2 c = 1 If tabl.Rows.count * tabl.Columns.count < fd.SelectedItems.count Then count = tabl.Rows.count * tabl.Columns.count Else count = fd.SelectedItems.count End If For k = 1 To count filename = fd.SelectedItems(k) Set shp = tabl.Cell(r, c).Shape slideObj.Shapes.AddPicture filename, msoCTrue, msoFalse, shp.Left, shp.Top, shp.Width, shp.Height c = (c Mod tabl.Columns.count) + 1 If c = 1 Then r = r + 2 Next End Sub

Em đã mở file PP, chạy code và bị báo lỗi "Run-time error '-214722164 (80040154)': Class not registered" ở dòng lệnh:
If ActivePresentation.Slides.count = 0 Then Exit Sub
Mong anh hướng dẫn giúp ạ!
Em cảm ơn anh!

batman1 · 10/2/22

mickey1485 đã viết:
Em đã mở file PP, chạy code và bị báo lỗi "Run-time error '-214722164 (80040154)': Class not registered" ở dòng lệnh:
If ActivePresentation.Slides.count = 0 Then Exit Sub
Mong anh hướng dẫn giúp ạ!
Em cảm ơn anh!

Bạn tự nhiên chen vào chủ đề của người khác, tập tin của bạn thế nào? Hãy lấy tập tin PP trong bài 7.

mickey1485 · 10/2/22

batman1 đã viết:
Bạn tự nhiên chen vào chủ đề của người khác, tập tin của bạn thế nào? Hãy lấy tập tin PP trong bài 7.

Em lấy tập tin trong bài 7 và code anh viết trong bài 8 ạ!

batman1 · 10/2/22

mickey1485 đã viết:
Em lấy tập tin trong bài 7 và code anh viết trong bài 8 ạ!

Sao tôi không thấy ai kêu. Nếu bạn kêu thì hãy đính kèm tập tin mà bạn vừa thử.

mickey1485 · 10/2/22

batman1 đã viết:
Sao tôi không thấy ai kêu. Nếu bạn kêu thì hãy đính kèm tập tin mà bạn vừa thử.

Em xin gửi file đính kèm với code trong module2. Các file ảnh và file powerpoint giống như bài 7 nên em xin phép không gửi lại ạ!

batman1 · 10/2/22

mickey1485 đã viết:
Em xin gửi file đính kèm với code trong module2. Các file ảnh và file powerpoint giống như bài 7 nên em xin phép không gửi lại ạ!

Tập tin Excel chỉ là để minh họa ý đồ cần làm cho tập tin PP.

Trong bài 7 có đính kèm tập tin PPTX, và code người ta muốn đặt trong tập tin này chứ không phải trong tập tin Excel.

Nói suông khó đoán mò. Có tập tin đính kèm là lòi ngay đuôi chuột. Nhớ là lần sau ...

mickey1485 · 10/2/22

batman1 đã viết:
Tập tin Excel chỉ là để minh họa ý đồ cần làm cho tập tin PP.

Trong bài 7 có đính kèm tập tin PPTX, và code người ta muốn đặt trong tập tin này chứ không phải trong tập tin Excel.

Nói suông khó đoán mò. Có tập tin đính kèm là lòi ngay đuôi chuột. Nhớ là lần sau ...

Em đã hiểu rồi. Xin lỗi đã làm phiền anh!
Em cảm ơn anh!

ngocmit2507 · 13/2/22

batman1 đã viết:
Do bạn không nói rõ nên tôi giả thiết như sau.

Ảnh luôn được chèn vào bảng theo thứ tự nhất định: xuất phát từ dòng có ảnh thứ 1, cột thứ 1 và đi tới cột cuối cùng dòng rồi nhẩy sang dòng tiếp theo có ảnh. Code sẽ chèn ảnh theo thứ tự được chọn. Tức nếu chọn theo thứ tự 15.jpg, 1.jpg, 2.jpg, ..., 14.jpg (thứ tự chọn có thể thực hiện bằng cách vd. giữ phím Ctrl rồi click từng ảnh) thì 15.jpg sẽ được chèn vào dòng 1 cột 1 có ảnh, 1.jpg sẽ được chèn vào dòng 1 cột 2 có ảnh.

Không cần chọn cell nào trước khi chọn ảnh. Code sẽ chèn các ảnh được chọn vào TABLE theo thứ tự nói ở trên.

Nếu chọn ít hơn số cell thì những cell cuối không có ảnh. Nếu chọn nhiều hơn số cell thì những ảnh cuối không được chèn ở bất cứ chỗ nào.

Nếu ngoài JPG còn nhiều định dạng được dùng thì thêm vào code vào FILTERS.

Code bên PP

Mã:

Sub chen_anh() Dim r As Long, c As Long, k As Long, count As Long, filename As String, tabl As Table, slideObj As Slide, fd As FileDialog, shp As Shape If ActivePresentation.Slides.count = 0 Then Exit Sub Set slideObj = ActivePresentation.Slides(1) If slideObj.Shapes.count = 0 Then Exit Sub If slideObj.Shapes(1).HasTable = 0 Then Exit Sub Set tabl = slideObj.Shapes(1).Table Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Images", "*.jpg; *.jpeg" If .Show <> -1 Then Exit Sub End With r = 2 c = 1 If tabl.Rows.count * tabl.Columns.count < fd.SelectedItems.count Then count = tabl.Rows.count * tabl.Columns.count Else count = fd.SelectedItems.count End If For k = 1 To count filename = fd.SelectedItems(k) Set shp = tabl.Cell(r, c).Shape slideObj.Shapes.AddPicture filename, msoCTrue, msoFalse, shp.Left, shp.Top, shp.Width, shp.Height c = (c Mod tabl.Columns.count) + 1 If c = 1 Then r = r + 2 Next End Sub

Thầy ơi , Thầy có thể sửa code giúp em được không ạ.
- Mục đích của em cũng là chèn ảnh vào bảng.Tuy nhiên Slide của em có 3 bảng tách biệt nên khi em sử dụng code trên không phù hợp do số thứ tự Slide không phải slide 1 và số lượng bảng cũng lớn hơn 1 bảng.
- Vậy có thể sử dụng VBA để chèn ảnh lần lượt vào các bảng trên cùng 1 Slide không ạ.
File Powpoint của em cần ghép ảnh có 3 bảng:
Bảng 1 : Tương ứng với mục 1.Vật nuôi =>Sẽ chèn ảnh lấy từ thư mục ảnh vật nuôi.
Bảng 2 : Tương ứng với mục 2.Động vật dưới nước =>Sẽ chèn ảnh lấy từ thư mục ảnh Động vật dưới nước.
Bảng 3 : Tương ứng với mục 3.Động vât trên cạn=> sẽ chèn ảnh từ thư mục ảnh Động vât trên cạn.

Rất Mong thầy và các anh các chị giúp đỡ em ạ.

batman1 · 13/2/22

ngocmit2507 đã viết:
Thầy ơi , Thầy có thể sửa code giúp em được không ạ.
- Mục đích của em cũng là chèn ảnh vào bảng.Tuy nhiên Slide của em có 3 bảng tách biệt nên khi em sử dụng code trên không phù hợp do số thứ tự Slide không phải slide 1 và số lượng bảng cũng lớn hơn 1 bảng.
- Vậy có thể sử dụng VBA để chèn ảnh lần lượt vào các bảng trên cùng 1 Slide không ạ.
File Powpoint của em cần ghép ảnh có 3 bảng:
Bảng 1 : Tương ứng với mục 1.Vật nuôi =>Sẽ chèn ảnh lấy từ thư mục ảnh vật nuôi.
Bảng 2 : Tương ứng với mục 2.Động vật dưới nước =>Sẽ chèn ảnh lấy từ thư mục ảnh Động vật dưới nước.
Bảng 3 : Tương ứng với mục 3.Động vât trên cạn=> sẽ chèn ảnh từ thư mục ảnh Động vât trên cạn.

Rất Mong thầy và các anh các chị giúp đỡ em ạ.

1. Code trong tập tin.

2. Do tập tin có nhiều slide nên mấu chốt là phải xác định code sẽ thao tác cho slide nào. Hiện thời slide cần thao tác là slide đứng thứ 5, và cũng là slide cuối cùng. Do bạn không nói rõ là tương lai có thêm slide nữa không nên để chắc chắn tôi không dùng con số 5, cũng không dùng vị trí CUỐI CÙNG. Trước khi chạy code thì phải cuộn xuống tới khi nhìn thấy slide cần thao tác ở bên phải, còn ở bên trái thì slide đó được viền khung.

3. Nếu xác định theo thứ tự (vd. 5) hay vị trí (cuối cùng) tiện hơn cho bạn với dự định tương lai thì nói rõ slide luôn ở vị trí nào (5 hay cuối cùng). Lúc đó tôi sẽ sửa code.

4. Hiện thời luôn luôn phải giữ ảnh trên đĩa, mang tập tin sang máy khác thì phải mang các thư mục ảnh theo. Nếu muốn sau khi chèn ảnh thì xóa ảnh trên đĩa và khi sang máy khác không phải mang các thư mục ảnh theo thì sửa

Mã:

shps.AddPicture filename, msoTrue, msoFalse, temp.left, temp.top, temp.Width, temp.Height

thành

Mã:

shps.AddPicture filename, msoFalse, msoTrue, temp.left, temp.top, temp.Width, temp.Height

Insert nhiều ảnh vào Table trong Powpoint sử dụng VBA

Thành viên mới

File đính kèm

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

File đính kèm

Thành viên mới

Thành viên mới

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

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

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

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

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

Thành viên mới

Thành viên mới

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

Thành viên mới

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

Thành viên mới

File đính kèm

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

Thành viên mới

Thành viên mới

File đính kèm

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

File đính kèm

Đếm ngược thời gian