Copy Single Word Table Cell to a new document

Melsy · #1 05-03-2023, 04:28 PM

Hi All,

First time poster here and Word Macro novice, so would appreciate any help I can get.

I am trying to create a macro which:

1 - Copies a single cell of formatted text inside a table (Table 2, Row 2, Column 1 - to be exact) of the open document

2 - Creates a new word document with the same single table cell and formatting

3 - Names the document to the same file name - but to a different folder

4 - Saves as a PDF

Hoping someone can help me.

gmayor · #2 05-03-2023, 11:30 PM

That seems fairly straightforward. Change the path to the location where you want to save the PDF (that path must exist).

Code:

Sub CellToPDF()
'Graham Mayor - https://www.gmayor.com - 04 May 2023 

Dim oTable As Table
Dim oCell As Cell
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)
    Set oCell = oTable.Cell(2, 1)
    oCell.Select
    Selection.Copy
    Set oNew = Documents.Add
    Set oRng = oNew.Range
    oRng.Paste
    Debug.Print strPath & 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

Melsy · #3 05-04-2023, 12:02 AM

Hi Graham,

Just tested it, and the code works perfectly! You are a force to be reckoned with! I had tried so many different codes based on previous posts on this forum, to no avail. You have definitely made my day - Thank you so much!!

Melsy · #4 09-20-2023, 08:40 PM

Hi Guys,

Thanks so much for your previous help on this... the above macro has been working like a dream for the past few months...

Although - I now also require a macro to do the exact same thing as per my previous post, however instead of only selecting a specific single cell, I need it print out all the rows of a specific column (step 1 on my original post)

So this would be for Table 2, Column 1, and ALL rows from top to bottom on the table in that column

Hoping to hear again from you soon...

Thank you!

gmayor · #5 09-21-2023, 03:40 AM

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

Melsy · #6 09-21-2023, 05:32 PM

You have defintely outdone yourself once again Graham!

The minor tweak to select column 1 is exactly what I was after - although I am embarrased to admit - I did try tweak the code myself - but failed miserably, as I couldn't quite pin point how to change the code from Cell over to Column.

You are such an extraordinary person and I truly cannot thank you enough for all your help!

miumiu4546 · #7 10-08-2023, 09:56 PM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Narrow single-cell table with text wrapping doesn't allow table to break across pages	klyjen	Word Tables	1	05-04-2023 04:55 PM
Copy text from one table to another table in word document	rajsf123	Word VBA	1	10-21-2016 10:08 PM
Within a table format, a single cell can't automatically flow to the next page?	laurieli	Word	3	12-09-2015 07:09 PM
How do I create a table in Word where I can single click a cell and it automatically highlights?	QA Inspector	Word	2	05-14-2015 07:22 PM
Can I create a single-cell table that moves with the text?	lcaretto	Word Tables	7	11-01-2013 06:04 AM