#1
|
|||
|
|||
table and code accidentally working only on odd rows
Hi all.
I have a table with n lines. The first column has fixed width and contains short paragraphs (mostly composed by a single word). I use the following code to automatically shrink paragraphs which are too long (reducing characters size and spacing), until they fit into a single line. The problem is that the code works only on the odd lines of the table, while the even ones remains untocuhed. Why? How can I solve? Thanks for your help. ------------ Dim EOC As String Dim p As Paragraph Dim rng As Range Dim chkspace As Single EOC = Chr(13) & Chr(7) ' this combination marks the end of a cell For Each p In ActiveDocument.Paragraphs If p.Range.Text Like "*" & EOC Then Set rng = p.Range 'commenting out next line will select the whole cell rng.MoveEnd wdCharacter, -1 rng.Select 'MsgBox "Found paragraph at end of cell..." Else Set rng = p.Range 'commenting out next line will select the whole cell rng.MoveEnd wdCharacter, -1 rng.Select 'MsgBox "Found paragraph NOT at end of cell..." With p.Range While .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) 'compare the line number of the first character of the paragraph and the line number of the last a = .Font.Size 'MsgBox (A) rng.Font.Size = a - 0.5 If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) Then If rng.Font.Spacing > -0.3 Then rng.Font.Spacing = rng.Font.Spacing - 0.05 If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharact erLineNumber) Then If rng.Font.Spacing > -0.3 Then rng.Font.Spacing = rng.Font.Spacing - 0.05 End If End If Wend End With End If Next p |
#2
|
|||
|
|||
Other than selecting text, your posted code isn't doing anything with the text in a table paragraph.
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oPar As Paragraph Dim oRng As Range Dim dblSize As Double For Each oPar In ActiveDocument.Paragraphs Set oRng = oPar.Range With oRng .MoveEnd wdCharacter, -1 While .Information(wdFirstCharacterLineNumber) <> .Characters.Last.Information(wdFirstCharacterLineNumber) dblSize = .Font.Size oRng.Font.Size = dblSize - 0.5 If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharacterLineNumber) Then If oRng.Font.Spacing > -0.3 Then oRng.Font.Spacing = oRng.Font.Spacing - 0.05 If .Information(wdFirstCharacterLineNumber) <> .Characters(Len(.Text)).Information(wdFirstCharacterLineNumber) Then If oRng.Font.Spacing > -0.3 Then oRng.Font.Spacing = oRng.Font.Spacing - 0.05 End If End If Wend End With Next oPar lbl_Exit: Exit Sub End Sub |
#3
|
|||
|
|||
Greg, thanks for the assistance.
Consider me more than a newbie Word VBA. I put together this code long ago after saeveral attempts of (intelligent ) copying & editing and from various web sources. It is applied by AutoOpen to a table created by mailmerge from a Access file. I just realised the following (puzzling) facts: - when applied to the table they're meant to work with, my code and your code give exactly the same result - when applied to a new, normal table, created for test, your code works perfectly (no problem with even rows), while my code does absolutely nothing. So the point is the structure of the file where they should be applied, obviosuly there's some big point that I'm missing. Attached, there is my actual file (CollLabSp21mm.doc) and a testfile.doc containing a sample table originating from mailmerge. |
#4
|
|||
|
|||
Marco,
Not sure what is going on with the table structure, but the reason the row is skipped is because every "b" in the what appears visually as two lines returns 6 Using: ?Selection..Information(wdFirstCharacterLineNumber ) In the immediate window. |
#5
|
|||
|
|||
OK (and so I learned how to use the immediate window )
So, the code reads the broken word as being in the same line, and this happens for all paragraphs in each even row, and VBA will read any line in that cell as line 6. On the other hand, if I select the word "bbb..bb" and open the statistic window, it correctly reads it as two lines. Anyway, I realise now that what I have is not a table with three rows, but three tables aligned one next the other: this is unnecessary and for sure solving it will solve the bug. In fact, if you - set the document to one column - add two rows to table one - past there the others two tables and run the code, you get the correct result. So the final question is: how to get a Mail Merge file that rather than repeating n times my table, will add rows to it (one rows for each record to merge)? |
#6
|
||||
|
||||
Not only does your document have three tables, but each of those tables has two columns. The cell in the second column contains '0' formatted with 2 point Arial font?
It appears from your comments that you want to reduce the font size of the long paragraph in the first column until it fits on one line? That being the case the following macro will do the job. Code:
Option Explicit Sub ShrinkParagraphText() Dim oTable As Table Dim oRow As Row Dim oCell As Cell Dim oRng As Range Dim oPara As Paragraph For Each oTable In ActiveDocument.Tables For Each oRow In oTable.Rows Set oCell = oRow.Cells(1) Set oRng = oCell.Range oRng.End = oRng.Paragraphs(1).Range.End - 1 Do While NumLines(oRng) > 1 oRng.Font.Shrink Loop Next oRow Next oTable lbl_Exit: Set oTable = Nothing Set oRow = Nothing Set oCell = Nothing Set oRng = Nothing Set oPara = Nothing Exit Sub End Sub Function NumLines(rng As Range) As Long Const wdStatisticLines As Long = 1 NumLines = rng.ComputeStatistics(wdStatisticLines) lbl_Exit: Exit Function End Function If you want to mail merge into a table and create a new row for each record, then create a single row table. Put your merge fields in the cells of that row and set the merge type to 'Directory'. Merge to a new document.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#7
|
|||
|
|||
Gmayor, thanks.
Yes, the second column is as it is meant to be. What I want to do is to shrink paragraphs (single-wor paragraphs) in the first column until they fit into a single line. In the example each row has a single paragraph but there may be more than one. The long words in the document are just for test, actual content has a more reasonable size if compared to the table. Now I will check your suggestions and let you know. |
#8
|
||||
|
||||
If there is more than one long paragraph loop through the range paragraph collection and process each one.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#9
|
|||
|
|||
I started from the mail merge point: the method of my original file IS set to "directory" (you can check it, the file is "CollLabSp21mm.doc")... so what's going on?
Why do I get my table repeated rather than having the addition of more rows? |
#10
|
|||
|
|||
Marco, Graham,
The following also worked with Marco's example tables (a's, b's and c'). Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oPar As Paragraph Dim oRng As Range Dim dblSize As Double For Each oPar In ActiveDocument.Paragraphs Set oRng = oPar.Range With oRng .MoveEnd wdCharacter, -1 Do While .ComputeStatistics(wdStatisticLines) > 1 dblSize = .Font.Size oRng.Font.Size = dblSize - 0.5 If oRng.Font.Spacing > -0.3 Then oRng.Font.Spacing = oRng.Font.Spacing - 0.05 Loop End With Next oPar lbl_Exit: Exit Sub End Sub ?Selection.Information(wdFirstCharacterLineNumber) in the Immediate windows 1 3 6 6 7 8 That indicates that the paragraphs containing the b's, the tiny empty paragraph after it and the paragraph containing the text "Test 2" is all contained within the same line and clearly visually at least it is not. What makes this cell containing 3 paragraphs different from the other 2 or why is .Information(wdFirstCharacterLineNumber) reporting erratically in this case? |
#11
|
|||
|
|||
OK, we have a multiple table with multiple misteries.
Now I'm leaving for the weekend, will be probably offline for a couple of days. bye for now |
#12
|
||||
|
||||
The reason that the merge produces a separate table for each record is that the merge document contains a section break, which forces the creation of a new table. Remove the section break from the merge document and the merge is to separate rows.
Adding the paragraph collection, as I suggested processes all the first column paragraphs, whether there is one table or many. Code:
Option Explicit Sub ShrinkParagraphText() Dim oTable As Table Dim oRow As Row Dim oCell As Cell Dim oRng As Range Dim oPara As Paragraph For Each oTable In ActiveDocument.Tables For Each oRow In oTable.Rows Set oCell = oRow.Cells(1) For Each oPara In oCell.Range.Paragraphs Set oRng = oPara.Range oRng.End = oRng.End - 1 Do While NumLines(oRng) > 1 oRng.Font.Shrink Loop Next oPara Next oRow Next oTable lbl_Exit: Set oTable = Nothing Set oRow = Nothing Set oCell = Nothing Set oRng = Nothing Set oPara = Nothing Exit Sub End Sub Function NumLines(rng As Range) As Long Const wdStatisticLines As Long = 1 NumLines = rng.ComputeStatistics(wdStatisticLines) lbl_Exit: Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#13
|
|||
|
|||
gmayor and gmaxey, thanks.
Now everything works fine and although the mistery of the "line 6" remains unsolved, I think I will have anyway a good sleep tonight Thanks again for you kind help! |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
I want to add multiple rows into my document but I can not figure out the code | jlw15931 | Mail Merge | 1 | 02-24-2015 05:03 AM |
Header Rows in Tables Not Working | Andy Pilkington | Word | 2 | 10-10-2014 12:36 AM |
Is it possible to copy non-contiguous rows of a Table and paste them as a separate Table in Word? | Joey Cheung | Word Tables | 1 | 08-12-2014 05:15 PM |
VBA Code to take data from a table in word document and place it in a summary table | VBLearner | Word VBA | 1 | 03-09-2014 08:42 PM |
Grouping table rows to prevent individual rows from breaking across pages | dennist77 | Word | 1 | 10-29-2013 11:39 PM |