![]() |
#1
|
|||
|
|||
![]()
Hi! I'm new to the forum
Sort of an advanced question, I think? THE FOLLOWING WORKS But it's slow. It takes about a half hour to work through an 84 page document Maybe my biggest question is state management In Excel, I can turn off printer communication, formula calculation, etc. to add a ton of speed. None of that appears to be a thing for Word VBA - except for maybe screen updating. (And that doesn't appear to work - I can still watch the macro's progress before Word locks up?) My second (less important) question is is there a simpler approach? (A lot of my first attempts included a few things that wouldn't work for manipulating a varied-column-count table.) I have a lot of experience with Excel VBA - but hardly any with Microsoft Word VBA. So maybe I'm taking the wrong approach? Thinking in tables instead of strings? Here's the situation: I'm using Acrobat Pro to export a PDF into Word ... so I can paste it into Excel and read/manipulate the numbers. The exporter (or the PDF itself?) has a few flaws: It doesn't create one, uniform table (same number of columns, same width, all rows) ... it sort of barfs it all into row after row - with diverse (apparently arbitrary?) column counts and widths. Worse, the exporter uses tab stops and alignment to format the table from there - it looks great (like the PDF) but cannot be read as data. (Exporting direct to Excel is worse - it just skips the tab stops and alignment part altogether. Without that formatting, I have even fewer clues to tell what information corresponds to what column, etc..) So here's what I have so far The code below uses delimiters to: Replace each tab character with the associated tab stop's apparent page position Add the apparent right margin's page position to right-justified cells What it creates, I can paste into Excel and use another (much faster) macro to redistribute data across columns - i.e. 1.42 inches to 1.95 inches = destination column 3, etc. Code:
Option Explicit Private Sub wordMacro_start() Dim xcount As Long Dim xcol As Long, xrow As Long, xlng As Long Dim xstr As String Dim xdbl As Double 'Tracks macro's speed Dim startTime As Date startTime = Now() Application.ScreenUpdating = False Dim tbl As Table Dim tbs As TabStop Dim rng As Range 'Loops through every table For Each tbl In ActiveDocument.Tables xcount = xcount + 1 Debug.Print xcount 'So I can read progress DoEvents 'So I have windows to pause execution 'Loops through every column xcol = 1 Do If xcol > tbl.Columns.Count Then Exit Do 'Loops through every row xrow = 1 Do If xrow > tbl.Rows.Count Then Exit Do 'Skips when cell address doesn't exist within the table Set rng = Nothing On Error Resume Next Set rng = tbl.Cell(xrow, xcol).Range On Error GoTo 0 If Not rng Is Nothing Then 'Tab stops and tab characters 'Loops through every tab stop within the cell For Each tbs In rng.Paragraphs.TabStops 'Gets starting position of next tab character xlng = InStr(1, rng.Text, vbTab) If xlng = 0 Then Exit For 'Gets position of the tab stop + previous cell widths in the row 'Equals page position, sorta xstr = rng.Text xstr = Left(xstr, xlng - 1) & _ "{" & (pullRecursive_width(tbl, xrow, xcol) - _ PointsToInches(tbl.Cell(xrow, xcol).Width)) + _ PointsToInches(tbs.Position) _ & "}" & _ Right(xstr, Len(xstr) - xlng) 'Replaces the tab character with the position number rng.Text = xstr Next tbs 'Alignment 'Fortunately, cells with right alignments don't generate with tab characters 'If alignment is right If tbl.Cell(xrow, xcol).Range.Paragraphs.Alignment = wdAlignParagraphRight Then 'If cell didn't generate as 'empty' If tbl.Cell(xrow, xcol).Range.Text <> Chr(13) & _ Chr(7) Then 'Gets this + all previous cell widths in the row 'Equals page position of the right margin of the cell xdbl = pullRecursive_width(tbl, xrow, xcol) xstr = "{" & _ xdbl & "}" & _ rng.Text 'Adds the position to the cell width rng.Text = xstr End If End If End If xrow = xrow + 1 Loop xcol = xcol + 1 Loop Next tbl 'Takes forever, sometimes start it and leave - so I have the macro save on finish ActiveDocument.Save 'Describes macro's speed MsgBox "(" & Format(Now() - startTime, "Nn \mi\nute\s, Ss \se\co\n\d\s") & ")" Application.ScreenUpdating = True End Sub Private Function pullRecursive_width(sent_table As Table, _ xrow As Long, _ xcol As Long) As Double 'Starts with current cell's width pullRecursive_width = PointsToInches(sent_table.Cell(xrow, xcol).Width) 'If current cell is first cell, returns If xcol <= 1 Then Exit Function 'If current cell isn't first cell, adds previous cell's width pullRecursive_width = pullRecursive_width + _ pullRecursive_width(sent_table, xrow, xcol - 1) End Function |
Tags |
state, tabstops |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to Prevent auto period after two-letter state abbreviation | gogreen | Word | 12 | 05-19-2018 08:36 PM |
Cable management | adminstefan | Visio | 1 | 02-13-2017 08:48 AM |
![]() |
Andrew H | Word | 1 | 11-08-2012 07:36 PM |
Resetting to Default State not working | carlgrossman | Word | 0 | 08-02-2008 01:31 AM |
Please help with Sum formula to add totals by State! asap | dutch4fire23 | Excel | 0 | 07-28-2006 12:41 PM |