|
生成PDF文件
- Sub ykcbf() '//2024.7.16
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set d = CreateObject("Scripting.Dictionary")
- Set fso = CreateObject("Scripting.FileSystemObject")
- p = ThisWorkbook.Path & ""
- arr = Sheets("数据").UsedRange
- b = [{1,5,6,7,8,9,10,11,4}]
- For i = 5 To UBound(arr)
- If Val(arr(i, 1)) Then
- s = arr(i, 3) & "|" & arr(i, 2)
- If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
- d(s)(i) = i
- End If
- Next
- For Each k In d.keys
- t = Split(k, "|")
- Sheets("模板").Copy
- Set wb = ActiveWorkbook
- m = 0
- With wb.Sheets(1)
- .[b2] = t(0): .[i2] = t(1)
- .Name = t(0)
- .UsedRange.Offset(3).ClearContents
- For Each kk In d(k).keys
- m = m + 1
- .Cells(m + 3, 1) = Format(m, "00")
- For j = 2 To UBound(b)
- .Cells(m + 3, j) = arr(kk, b(j))
- Next
- Next
- .[a4].Resize(m, UBound(b)).Borders.LineStyle = 1
- End With
- p1 = p & t(0) & ""
- If Not fso.FolderExists(p1) Then fso.CreateFolder p1
- wb.Sheets(1).ExportAsFixedFormat xlTypePDF, p1 & t(0) & Format(t(1), "yyyymd") & ".pdf"
- wb.Close 0
- Next
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|