10-08-2023, 09:56 PM
|
Novice
|
|
Join Date: Oct 2023
Posts: 5
|
|
Quote:
Originally Posted by gmayor
The process is essentially similar
Code:
Sub ColumnToPDF()
'Graham Mayor - https://www.gmayor.com - 21 September 2023
Dim oTable As Table
Dim oRng As Range
Dim oDoc As Document, oNew As Document
Dim intPos As Integer
Dim strDocName As String
Const strPath As String = "C:\path\" 'the path where the document is to be saved
If ActiveDocument.Tables.Count < 2 Then GoTo lbl_Exit
Set oDoc = ActiveDocument
Start:
strDocName = oDoc.Name
intPos = InStrRev(strDocName, ".")
If intPos = 0 Then
oDoc.Save
GoTo Start
End If
strDocName = Left(strDocName, intPos - 1)
strDocName = strPath & strDocName & ".pdf"
Set oTable = ActiveDocument.Tables(2)
oTable.Columns(1).Select
Selection.Copy
Set oNew = Documents.Add
Set oRng = oNew.Range
oRng.Paste
Debug.Print strDocName
oNew.ExportAsFixedFormat OutputFileName:=strDocName, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
oNew.Close 0
lbl_Exit:
Exit Sub
End Sub
|
Wow! That's brilliant
|