![]() |
#1
|
||||
|
||||
![]()
I have large text file having repeating lines as follow
![]() I want to fit the text in the table like this ![]() I have following macro but the problem is it is for small text. I don't know how to loop. I optionally made repeatations but it throws error after say 20 repetition. my macro is as following: Sub PLR() ' ' PLR Macro ' ' Selection.Delete Unit:=wdCharacter, Count:=1 Selection.WholeStory Selection.Font.Name = "Palatino Linotype" Selection.Font.Size = 12 If Selection.PageSetup.Orientation = wdOrientPortrait Then Selection.PageSetup.Orientation = wdOrientLandscape Else Selection.PageSetup.Orientation = wdOrientLandscape End If Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _ NumRows:=954, AutoFitBehavior:=wdAutoFitFixed With Selection.Tables(1) If .Style <> "Table Grid" Then .Style = "Table Grid" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With Selection.InsertColumns Selection.InsertColumns Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=206.7, RulerStyle:= _ wdAdjustNone Selection.Tables(1).AllowAutoFit = False Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=206, RulerStyle:= _ wdAdjustNone Selection.Tables(1).Columns(3).SetWidth ColumnWidth:=418.5, RulerStyle:= _ wdAdjustNone Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.TypeText Text:="Abstract:" Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeText Text:="." Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdPasteDefault) Selection.EndKey Unit:=wdLine Selection.TypeBackspace Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow Selection.TypeBackspace Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.TypeText Text:="Abstract:" Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeText Text:="." Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdPasteDefault) Selection.EndKey Unit:=wdLine Selection.TypeBackspace Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow Selection.TypeBackspace Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeParagraph Selection.TypeText Text:="Abstract:" Selection.TypeParagraph Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis) Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.EndKey Unit:=wdLine Selection.TypeText Text:="." Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdPasteDefault) Selection.EndKey Unit:=wdLine Selection.TypeBackspace Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow Selection.TypeBackspace |
#2
|
||||
|
||||
![]()
Ouch!
Try the following instead. This will work as long as the repeats are as show and there is a multiple of 5 lines in the source. Code:
Option Explicit Sub PLR() 'Macro by Graham Mayor 2015 Dim oSource As Document Dim oTarget As Document Dim oTable As Table Dim oRow As Row Dim oCell As Range Dim oPara As Range Dim i As Long Set oSource = ActiveDocument Set oTarget = Documents.Add 'Setup the table document oTarget.PageSetup.PaperSize = wdPaperLetter oTarget.PageSetup.Orientation = wdOrientLandscape oTarget.PageSetup.LeftMargin = InchesToPoints(0.35) oTarget.PageSetup.RightMargin = InchesToPoints(0.25) 'Setup the table size Set oTable = oTarget.Tables.Add(oTarget.Range, 1, 3) With oTable .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False .AllowAutoFit = False .Columns(1).SetWidth _ ColumnWidth:=206, _ RulerStyle:=wdAdjustNone .Columns(2).SetWidth _ ColumnWidth:=206, _ RulerStyle:=wdAdjustNone .Columns(3).SetWidth _ ColumnWidth:=338, _ RulerStyle:=wdAdjustNone End With On Error GoTo lbl_Exit For i = 1 To oSource.Paragraphs.Count Step 5 Set oRow = oTable.Rows.Last Set oPara = oSource.Paragraphs(i).Range 'Process column 3 Set oCell = oRow.Cells(3).Range oCell.End = oCell.End - 1 oCell.FormattedText = oPara.FormattedText Set oPara = oSource.Paragraphs(i + 3).Range oPara.End = oPara.End - 1 oCell.Collapse 0 oCell.Text = "Add some text" & vbCr oCell.Collapse 0 oCell.FormattedText = oPara.FormattedText 'Process column 2 Set oCell = oRow.Cells(2).Range oCell.End = oCell.End - 1 Set oPara = oSource.Paragraphs(i + 4).Range oCell.FormattedText = oPara.FormattedText 'Process column 1 Set oCell = oRow.Cells(1).Range oCell.End = oCell.End - 1 Set oPara = oSource.Paragraphs(i + 2).Range oCell.FormattedText = oPara.FormattedText oCell.Collapse 0 Set oPara = oSource.Paragraphs(i + 1).Range oPara.End = oPara.End - 1 oCell.FormattedText = oPara.FormattedText 'If not the end of the list add a row 'Assumes no blank paragraphs at the end If i < oSource.Paragraphs.Count - 4 Then oTable.Rows.Add DoEvents Next i 'Format the table With oTable .Range.Font.name = "Palatino Linotype" .Range.Font.Size = 12 .Range.ParagraphFormat.SpaceAfter = 0 .Range.LanguageID = wdEnglishUS End With lbl_Exit: 'Clean up Set oSource = Nothing Set oTarget = Nothing Set oTable = Nothing Set oRow = Nothing Set oCell = Nothing Set oPara = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
||||
|
||||
![]()
The VBA works perfectly. Only thing to notice is in last five lines title3 and title2 not comming. Not problem for me just for your knowledge.
Sorry My problem. Working fine. Thak you very much. Last edited by PRA007; 03-16-2015 at 04:05 AM. Reason: My mistake |
#4
|
||||
|
||||
![]() Quote:
|
#5
|
||||
|
||||
![]()
Use the following instead
Code:
'Process column 2 Set oCell = oRow.Cells(2).Range oCell.End = oCell.End - 1 Set oPara = oSource.Paragraphs(i + 4).Range oPara.End = oPara.End - 1 oCell.FormattedText = oPara.FormattedText
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
![]() |
Tags |
macro, table, word 2010 |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Extra lines in directroy when field is blank | redzan | Mail Merge | 5 | 05-23-2014 06:40 PM |
Re-Arrange Generated Data | flds | Excel | 4 | 06-29-2012 08:17 AM |
![]() |
JustK | Word | 2 | 11-15-2011 11:17 AM |
Large gap between lines. | Balliol | Word | 8 | 12-14-2010 04:59 PM |
Text Wrapping on Fixed Lines in a Form field/Table cell | okrmjr | Word Tables | 0 | 10-30-2009 08:52 AM |