Em có nhiều file cần tách lấy trang đầu tiên. Thay vì file đổi đường dẫn liên tục, thì e có đoạn code lấy đường dẫn của các file PDF cần đổi tên vào cột A. Và em muốn chạy code để tách các file theo lần lượt đường dẫn ở cột A. Hiện tại e đang bị lỗi ở phần bôi đỏ. Mọi người xem chỉnh giúp e với ạ. Em cảm ơn!
Nhờ Anh chị xem giúp em đoạn code tách trang đầu của file pdf dựa vào phần mềm PDFtk
- Thread starter Hoantk223
- Ngày gửi
Nguyễn Duy Tứ
Thành viên mới
- Tham gia
- 9/9/16
- Bài viết
- 1
- Được thích
- 0
Chưa hiểu mục đích bạn muốn làm cái gì?
>>For i = 1 To Cells(2, 1).Value
->Giá trị của Cells(2, 1).Value là bao nhiêu? nó phải là 1 con số nhé
>>For i = 1 To Cells(2, 1).Value
->Giá trị của Cells(2, 1).Value là bao nhiêu? nó phải là 1 con số nhé
Bạn muốn làm gì thì trình bày rõ ràng.
Trạng thái TRUE có ý nghĩa là gì ? Bạn ghi như vậy khó có thể hiểu được, thì sao mà có thể giúp.
Cụm màu đỏ của bạn sai rất nhiều thứ, cả về cách hiểu, cách truy xuất và kể cả gán kết quả.
Trạng thái TRUE có ý nghĩa là gì ? Bạn ghi như vậy khó có thể hiểu được, thì sao mà có thể giúp.
Cụm màu đỏ của bạn sai rất nhiều thứ, cả về cách hiểu, cách truy xuất và kể cả gán kết quả.
True là thể hiện các file đã được tách ạ. Mình muốn lấy file đầu tiên của file PDf dựa vào phần mềm PDFtk. Ban đầu mình có đoạn code sau. Nhưng thay vì phải đổi tên đường dẫn trong code liên tục thì giờ mình muốn lấy đường dẫn vào code A và tách theo đường dẫn ở cột A đã được gọi, Sau khi tách xong thì hiển thị trạng thái đã tách vào cột B
Bài đã được tự động gộp:
Mình muốn chạy tách file theo đường dẫn ở cột A, dòng thứ 2 ạ
Cái này mình chạy nhưng nó không ra gì ạ
befaint
|||||||||||||
- Tham gia
- 6/1/11
- Bài viết
- 14,498
- Được thích
- 19,668
Nó mà ra gì có mà ngỏm củ tỏi à mình?
ongke0711
Thành viên gắn bó
- Tham gia
- 7/9/06
- Bài viết
- 2,199
- Được thích
- 2,909
- Giới tính
- Nam
Nhìn hình không thấy câu lệnh để chạy strParam befaint.
befaint
|||||||||||||
- Tham gia
- 6/1/11
- Bài viết
- 14,498
- Được thích
- 19,668
ongke0711
Thành viên gắn bó
- Tham gia
- 7/9/06
- Bài viết
- 2,199
- Được thích
- 2,909
- Giới tính
- Nam
Vậy là không chịu khó như tui rồi...Em bỏ dòng đó đi để xem mức độ chịu khó thôi mà.
phankhanhbm
Thành viên mới
- Tham gia
- 10/6/23
- Bài viết
- 1
- Được thích
- 0
Bạn có thể tham khảo thử. Đúng sai tùy duyên.
Sub SplitPDFtk()
Dim SourceFile As String, DestFile As String
Dim strParam As String, RetVal As String, PDFtk As String
Dim i As Long
PDFtk = "C:\Program Files (x86)\PDFtk\bin\pdftk.exe "
Application.ScreenUpdating = False
For i = 1 To Cells(2, 1).Value
SourceFile = Cells(2 + i, 1).Value
Cells(2 + i, 3).Value = "Done"
For j = 1 To Cells(2 + i, 2).Value
DestFile = "D:\" & "Page " & Format(j, "00") & " of " & Cells(2 + i, 2).Value & " " & _
Left(Right(SourceFile, Len(SourceFile) - InStrRev(SourceFile, "\")), Len(SourceFile) - InStrRev(SourceFile, ".") + 1) & ".pdf"
strParam = PDFtk & SourceFile & " cat " & j & " output """ & DestFile & """"
RetVal = Shell(strParam, 0)
Next j
Next i
Application.ScreenUpdating = True
MsgBox "Done.", vbInformation
End Sub
Sub SplitPDFtk()
Dim SourceFile As String, DestFile As String
Dim strParam As String, RetVal As String, PDFtk As String
Dim i As Long
PDFtk = "C:\Program Files (x86)\PDFtk\bin\pdftk.exe "
Application.ScreenUpdating = False
For i = 1 To Cells(2, 1).Value
SourceFile = Cells(2 + i, 1).Value
Cells(2 + i, 3).Value = "Done"
For j = 1 To Cells(2 + i, 2).Value
DestFile = "D:\" & "Page " & Format(j, "00") & " of " & Cells(2 + i, 2).Value & " " & _
Left(Right(SourceFile, Len(SourceFile) - InStrRev(SourceFile, "\")), Len(SourceFile) - InStrRev(SourceFile, ".") + 1) & ".pdf"
strParam = PDFtk & SourceFile & " cat " & j & " output """ & DestFile & """"
RetVal = Shell(strParam, 0)
Next j
Next i
Application.ScreenUpdating = True
MsgBox "Done.", vbInformation
End Sub
HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,589
- Được thích
- 3,983
- Giới tính
- Nam
@Hoantk223
Không cần dùng đến thư viện nào để giữ trang đầu tiên bạn nhé.
Chỉ cần chạy mã VBA là được rồi.
Không cần dùng đến thư viện nào để giữ trang đầu tiên bạn nhé.
Chỉ cần chạy mã VBA là được rồi.
JavaScript:
Option Explicit
Private Sub KeepingFirstPagePDF_test()
Dim s, re As Object, FSO As Object, i&, rg, lr&
Set rg = [A2]
lr = rg(50000, 1).End(3).row - rg.row + 1
s = "D:\PagePDF\"
If CreateFolder(s, FSO) Then
For i = 1 To lr
If rg(i, 2).value <> empty then rg(i, 2).value = KeepingFirstPagePDF(s, rg(i, 1).value, re, FSO)
Next
ActiveWorkbook.FollowHyperlink s, , True
End If
End Sub
Private Function KeepingFirstPagePDF(ByVal vFolder$, ByVal vFileName$, Optional RegExp As Object, Optional FSO As Object)
If Not vFileName Like "*.pdf" Then Exit Function
If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.fileExists(vFileName) Then Exit Function
Dim s$
If RegExp Is Nothing Then
Set RegExp = CreateObject("VBscript.RegExp")
With RegExp
.Global = True
.IgnoreCase = True
.MultiLine = True
s = "[^" & ChrW(7893) & "]+"
.Pattern = "(<</Type\s*/Page[^s]" & s & "?)\r?\n<</Type\s*/Page[^s]" & s & "\r?\n<</Type/XObject/" & s & "?\r?\nstream" & s & "?\r?\nendstream\r?\n(endobj)"
End With
End If
Dim n, e, xFileNum As Long, ms, m, y%, f
Dim b() As Byte
If Right(vFolder, 1) <> "\" Then vFolder = vFolder & "\"
s = ""
e = Split(vFileName, "\"): e = e(UBound(e))
n = Split(e, "."): e = n(UBound(n))
n(UBound(n)) = "": n = Join(n, ".")
xFileNum = FreeFile: Open vFileName For Binary As #xFileNum: s = Space(LOF(xFileNum)): Get #xFileNum, , s: Close #xFileNum
R:
If RegExp.Test(s) Then
s = RegExp.Replace(s, "$1$2"): y = y + 1: GoTo R
End If
If y Then
With CreateObject("ADODB.Stream")
.Mode = 3
.Charset = "Windows-1252"
.Open
.Writetext s
.Position = 0
.SaveToFile vFolder & n & e, 2
.Type = 2
.Position = 3
End With
KeepingFirstPagePDF = y
End If
End Function
Private Function CreateFolder(ByVal FolderPath As String, Optional ByRef FileSystem As Object) As Boolean
Dim FolderArray, tmp$, i As Integer, UB As Integer, tFolder$
tFolder = FolderPath
If Right(tFolder, 1) = "\" Then tFolder = Left(tFolder, Len(tFolder) - 1)
If tFolder Like "\\*\*" Then tFolder = Strings.Replace(tFolder, "\", "@", 1, 3)
FolderArray = Split(tFolder, "\")
If FileSystem Is Nothing Then
Set FileSystem = CreateObject("Scripting.FileSystemObject")
End If
On Error GoTo Ends
FolderArray(0) = Strings.Replace(FolderArray(0), "@", "\", 1, 3)
UB = UBound(FolderArray)
With FileSystem
For i = 0 To UB
tmp = tmp & FolderArray(i) & "\"
If Not .FolderExists(tmp) Then .CreateFolder (tmp)
CreateFolder = (i = UB) And Len(FolderArray(i)) > 0 And FolderArray(i) <> " "
Next
End With
Ends:
End Functiondạ VBA mình mới đang bắt đầu tự tìm hiểu nên có rất nhiều cái mình vẫn chưa biết ạEm bỏ dòng đó đi để xem mức độ chịu khó thôi mà.
Bài đã được tự động gộp:
Dạ em cho chạy thử mà nó lại báo vướng ở chỗ này, a xem giúp e với ạ
Ở đoạn này mình chạy từng dòng thấy đang bị báo ở chỗ này. Bạn xem giúp mình với ạ
befaint
|||||||||||||
- Tham gia
- 6/1/11
- Bài viết
- 14,498
- Được thích
- 19,668
Dạ e đang làm được đến đây rồi ạ.Ở đoạn này mình chạy từng dòng thấy đang bị báo ở chỗ này. Bạn xem giúp mình với ạ
Nhưng vẫn chưa biết cách làm sao chỉ bấm số trang bắt đầu và trang kết thúc cần cắt để không phải vào chỉnh sửa code ạ
Bài viết mới nhất
- Question
- Question
