làm sao để import/insert/embeb nhiều PDF file vào Excel

[Tường_Vi]

Em có dữ liệu sau

- 200 file PDF
- File excel có 200 dòng dữ liệu

Nếu chỉ có 1 file em sẽ insert object (PDF) vào để làm Tham chiếu cho 1 dòng dữ liệu nhưng giờ có 200 file PDF thì cách làm nào là nhanh nhất

Em thử tìm kiếm nhưng chưa có kết quả

Cám ơn

 

[Tường_Vi]

Mình không có cách nào sao?

 

[ndu96081631]

Em có dữ liệu sau

- 200 file PDF
- File excel có 200 dòng dữ liệu

Nếu chỉ có 1 file em sẽ insert object (PDF) vào để làm Tham chiếu cho 1 dòng dữ liệu nhưng giờ có 200 file PDF thì cách làm nào là nhanh nhất

Em thử tìm kiếm nhưng chưa có kết quả

Cám ơn

Thử record macro xem code viết thế nào rồi tính tiếp

 

[nmhung49]

Mình không có cách nào sao?

Mình record kết hợp với FileSystem nữa ra cái này bạn xem sử dụng được không

Sub InsertObj()
Dim FSOFile As Object, Item, i As Long
Set FSOFile = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    With FSOFile.GetFolder(.SelectedItems(1))
      For Each Item In .Files
      i = i + 5
      Cells(i, 1).Select
        ActiveSheet.OLEObjects.Add(Filename:=Item.Path, Link:=False _
        , DisplayAsIcon:=True, IconFileName:="C:\Windows\Installer\{AC76BA86-7AD7-1033-7B44-A90000000001}\PDFFile_8.ico", _
        IconIndex:=0, IconLabel:=Item.Path).Select
      Next Item
    End With
End With
End Sub

 

[Tường_Vi]

Em không thể dùng hyperlink vì phải gửi 200 file này đi (qua email) nên phải dùng insert object

Em thử record macro và cho nó vào vòng lặp nhưng gần được. Sửa lại code giúp em nhé

Sub Macro5()
'
' Macro5 Macro
'

'
    For i = 1 To 55
    ActiveSheet.OLEObjects.add(Filename:= _
        "E:\Test\" & Sheet5.cells(i + 1, 1) _
        , Link:=True, DisplayAsIcon:=True, IconFileName:= _
        "C:\WINDOWS\Installer\{AC76BA86-7AD7-1033-7B44-A80000000002}\PDFFile_8.ico", _
        IconIndex:=0, IconLabel:=Sheet5.cells(i + 1, 1)).Select
   ' Selection.ShapeRange.IncrementLeft 108#
    'Selection.ShapeRange.IncrementTop -67.5
    'Rows("1:1").RowHeight = 55.5
    'Columns("E:E").ColumnWidth = 11.75
    Next i
End Sub

 

[Tường_Vi]

Cám ơn
Em làm được rồi, giờ mình muốn sắp xếp các file PDF này theo dòng thì làm thế nào?

Em thấy 200 cáí file PDF nó chồng lên nhau

 

[Tường_Vi]

Em thêm đoạn code này nhưng chưa xếp các object theo thứ tự được

ActiveSheet.Shapes(Object & i).ShapeRange.IncrementLeft = Sheet5.cells(i + 1, 1).ColumnWidth

 

[ndu96081631]

Cám ơn Em làm được rồi, giờ mình muốn sắp xếp các file PDF này theo dòng thì làm thế nào? Em thấy 200 cáí file PDF nó chồng lên nhau

Nếu xếp bằng tay thì bạn sẽ làm thế nào? Nếu làm được bằng tay, hãy record macro tiếp nhé Nói chung cũng là:
- Canh Left của Object trùng với Left của cell nào đó
- Canh Right của Object trùng với Right của cell nào đó
- Canh Width của Object trùng với Width của cell nào đó
- Canh Height của Object trùng với Height của cell nào đó

 

[welcom1985]

theo tui biết thì hình như 200 cái file pdf này giống y hệt nhau về cách bố trí , tên tiêu đề ,số cột .... phải hem. (mấy cái này hình như thường gặp ở các file báo cáo được xuất ra từ các chương trình kế toán , quản lý ..v.v.... chúng thường giống nhau phần format)
nếu đúng như vậy thì đây là cách tôi làm :
1- dùng phần mềm nối 200 file pdf đó thành 1 file pdf duy nhất ....adolix split merge pdf
2- dùng phần mềm convert sang excel...khuyên dùng able2extract
3- mông má lại cái file cho đẹp (sẽ có các dòng tiêu đề bị trùng ....dùng filter rồi xoá các dòng đó là xong)

Khuyết điểm : kiểm tra các dấu , dấu . trong các con số có thể dẫn đến sai số (trước khi chuyển , bạn nên kiểm tra xem hệ số quy định trong máy tính của mình quy định dấu phân chia phần thập phân là dấu "chấm" hay là dấu "phẩy".)

 

[Tường_Vi]

Nếu xếp bằng tay thì bạn sẽ làm thế nào? Nếu làm được bằng tay, hãy record macro tiếp nhé Nói chung cũng là:
- Canh Left của Object trùng với Left của cell nào đó
- Canh Right của Object trùng với Right của cell nào đó
- Canh Width của Object trùng với Width của cell nào đó
- Canh Height của Object trùng với Height của cell nào đó

Em đoạn code này nhưng chưa được. Anh sửa giúp em nhé

   Selection.ShapeRange.IncrementLeft = Sheet5.cells(i + 1, 2).Left
    Selection.ShapeRange.IncrementTop = Sheet5.cells(i + 1, 2).Top
    Selection.ShapeRange.ScaleWidth = Sheet5.cells(i + 1, 2).ColumnWidth
    Selection.ShapeRange.ScaleHeight = Sheet5.cells(i + 1, 2).Height

 

[Tường_Vi]

tại sao em dùng
sheet1.shapes("Object 1").top thì được nhưng chuyển qua dùng

sheet1.shapes("Object " & i).top thì lại báo lỗi

 

[ndu96081631]

Em đoạn code này nhưng chưa được. Anh sửa giúp em nhé

   Selection.ShapeRange.IncrementLeft = Sheet5.cells(i + 1, 2).Left
    Selection.ShapeRange.IncrementTop = Sheet5.cells(i + 1, 2).Top
    Selection.ShapeRange.ScaleWidth = Sheet5.cells(i + 1, 2).ColumnWidth
    Selection.ShapeRange.ScaleHeight = Sheet5.cells(i + 1, 2).Height

Code đâu phải viết vậy ---> Chỉnh Left, Top, Width, Height như tôi nói ở trên kia mà

Sub Macro5()
  Dim i As Long
  For i = 1 To 35
    With ActiveSheet.OLEObjects.Add(Filename:="E:\Test\" & Sheet5.Cells(i + 1, 1), Link:=True)
      .ShapeRange.LockAspectRatio = msoFalse
      .Left = .Parent.Cells(i + 1, 1).Left
      .Top = .Parent.Cells(i + 1, 1).Top
      .Width = .Parent.Cells(i + 1, 1).Width
      .Height = .Parent.Cells(i + 1, 1).Height
    End With
  Next i
End Sub

 

[Tường_Vi]

báo cáo , em đã làm được nhé
ke ke

 

[Tường_Vi]

Anh NDU ơi, code chạy ok nhưng mà những Object sau khi insert sẽ gây lỗi và không save được file

Lỗi báo Eror was detect...while saving...hic hic

 

[Tường_Vi]

Bỏ qua bài #14 giúp em nhé

======================================
200 file attach chỉ có ~8MB, không hiểu sao sau khi insert object nó lại lên tới hàng trăm MG nhỉ?

Hic, có thể đây là nguyên nhân gây lỗi

 

[Tường_Vi]

Code đâu phải viết vậy ---> Chỉnh Left, Top, Width, Height như tôi nói ở trên kia mà

Sub Macro5()
  Dim i As Long
  For i = 1 To 35
    With ActiveSheet.OLEObjects.Add(Filename:="E:\Test\" & Sheet5.Cells(i + 1, 1), Link:=True)
      .ShapeRange.LockAspectRatio = msoFalse
      .Left = .Parent.Cells(i + 1, 1).Left
      .Top = .Parent.Cells(i + 1, 1).Top
      .Width = .Parent.Cells(i + 1, 1).Width
      .Height = .Parent.Cells(i + 1, 1).Height
    End With
  Next i
End Sub

Anh NDU cứu em với

Với đoạn code trên, Khi em đổi tên Folder thì các file PDF đính trong các file excel không mở được.
Như vậy là mình dùng link rồi chứ không phải là add Object (vì link khi gửi sang máy khác sẽ ko mở được)

Anh giúp em cách add Object với.

 

[Tường_Vi]

  ActiveSheet.OLEObjects.add(ClassType:="AcroExch.Document.7", link:=False, _
        DisplayAsIcon:=True, IconFileName:= _
        "C:\WINDOWS\Installer\{AC76BA86-7AD7-1033-7B44-A80000000002}\PDFFile_8.ico", _
        IconIndex:=0, IconLabel:="Add-PDF-Test.pdf").Activate

Em vừa record quá trình embed file Add-PDF-Test.pdf

Từ đoạn code trên, Anh/Chị gắn giúp em vào vòng lặp với

 

[Tường_Vi]

Em đã tìm được nguyên nhân gây lỗi "can not insert Object" là do file PDF nếu được split cắt ra thì sẽ không insert được file PDF vào exel.

Em đã dùng phần mềm edit PDF meta properties và tình hình ok

Xin cám ơn mọi người