|
|
Thread Tools | Display Modes |
#16
|
||||
|
||||
Quote:
Quote:
Quote:
Quote:
I've incorporated the above, plus comments into the code in my previous post.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#17
|
|||
|
|||
I'm getting an error with this section saying "The requested member of the collection does not exist." When I hover over the i, it says i = 10, if that helps at all.
Code:
If .Cells(i + 4).ColumnIndex = 1 Then Set Rng = .Cells(i).Range Rng.End = .Cells(i + 4).Range.End Rng.Select: Selection.Cells.Merge End If Code:
With Tbl .Range.Rows.WrapAroundText = False Code:
For i = 5 To .Cells.Count Select Case (i Mod 5) + 1 Case 1: sWdth = InchesToPoints(0.45) .Cells().VerticalAlignment = wdCellAlignVerticalTop Code:
With .Range .Cells(1).Select: Selection.Rows.HeadingFormat = True For i = 1 To 4 .Cells(i).Width = InchesToPoints(sWdth(i)) Next ''my addition If .Cells.Width = InchesToPoints(0.45) Then .Cells().VerticalAlignment = wdCellAlignVerticalTop End If |
#18
|
||||
|
||||
Quote:
Quote:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#19
|
|||
|
|||
Today the same section is giving me a different error, this time regarding the Selection part:
Code:
If ((i Mod 5) + 1) = 1 Then If .Cells(i + 4).ColumnIndex = 1 Then Set Rng = .Cells(i).Range Rng.End = .Cells(i + 4).Range.End Rng.Select: Selection.Cells.Merge End If I got rid of text wrapping by adding the following code near the end, but that seemed to make the columns slightly offset from the first row. I tried fixing this by adjusting the Array widths slightly, some to 1000s of an inch, but that only fixed some. Any idea why this would be? Code:
End With Tbl.Rows.WrapAroundText = False Tbl.Rows.Alignment = wdAlignRowCenter End With Next End With Application.ScreenUpdating = True End Sub Last edited by CodingGuruInTraining; 09-27-2015 at 12:10 PM. Reason: now with image attached |
#20
|
||||
|
||||
The macro runs fine for me with the document you attached - all tables end up centred on the page with uniform layouts and no errors. I am unable to reproduce the problem you say you're having.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#21
|
|||
|
|||
I understand and I appreciate all of your efforts thus far. Perhaps you could try explaining what this code below is actually doing. To start with, how does the program know the criteria you listed?
Code:
'Format the remaining cells, in groups of 5. 'The first cell in each group spans two rows and 'the first row in each group contains 4 cells but 'the second row contains 1 cell spanning the width 'of the last 3 cells of the first row For i = 5 To .Cells.Count 'If it's the first cell in a group, ensure it's both merged and centred vertically If ((i Mod 5) + 1) = 1 Then If .Cells(i + 4).ColumnIndex = 1 Then Set Rng = .Cells(i).Range Rng.End = .Cells(i + 4).Range.End Rng.Select: Selection.Cells.Merge End If |
#22
|
|||
|
|||
I figured out what the problem was with the merging code; there were some extra tables in my document that follow a different cell arrangement and the macro didn't like them. When I deleted those tables, the code was able to run all the way through! I have been doing a lot of testing and I believe the issue with offset columns is due to either specific rows and/or the tables (corrupted?). I am still working it out to be sure.
Is there a way to present a pop-up or something where you can designate a page range for the macro to only run on? |
#23
|
||||
|
||||
To work with just the selected tables, try changing:
wdDoc As Document to: RngSel As Range and changing: Set wdDoc = ActiveDocument With wdDoc to: Set RngSel = Selection.Range With RngSel
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#24
|
|||
|
|||
That last addition will help. There are still some tables that don't work exactly right, which is a problem with the documents not the macro. How would you finish the original macro so that it moves the data from the original table into the new one while using the selected range option? I think I got the right code below and tried incorporating the selection part, but it's not working.
Code:
Sub Demo() Dim wdDoc As Document, Tbl As Table, Rng As Range, i As Long, j As Long, k As Long Application.ScreenUpdating = False Set RngSel = Selection.Range With RngSel For i = .Tables.Count To 1 Step -1 With .Tables(i).Range j = (.Cells(.Cells.Count).RowIndex - 1) / 2 .Paragraphs.Last.Next.Range.InsertBefore vbCr & vbCr & vbCr & vbCr Set Rng = .Paragraphs.Last.Next.Next.Range Rng.Collapse wdCollapseStart Set Tbl = wdDoc.Tables.Add(Range:=Rng, NumRows:=2, NumColumns:=4, AutoFitBehavior:=False) With Tbl .Borders.Enable = True .Rows.HeightRule = wdRowHeightAuto .Rows(1).Height = InchesToPoints(0.25) .Rows(2).Height = InchesToPoints(0.5) .Cell(2, 1).VerticalAlignment = wdCellAlignVerticalCenter .Columns.PreferredWidthType = wdPreferredWidthPoints .Rows(1).Shading.BackgroundPatternColorIndex = wdTurquoise .Columns(1).Shading.BackgroundPatternColorIndex = wdTurquoise .Columns(1).Width = InchesToPoints(0.45) .Columns(2).Width = InchesToPoints(1.5) .Columns(3).Width = InchesToPoints(2.38) .Columns(4).Width = InchesToPoints(2.33) Set Rng = .Range With Rng .SetRange Start:=.Cells(6).Range.Start, End:=.Cells(8).Range.End .Cells.Split NumRows:=2, NumColumns:=1, MergeBeforeSplit:=False .Rows.HeightRule = wdRowHeightAuto .SetRange Start:=Tbl.Range.Cells(9).Range.Start, End:=Tbl.Range.End .Cells.Merge .SetRange Start:=Tbl.Range.Cells(5).Range.Start, End:=Tbl.Range.End .Copy End With For k = 2 To j With .Range.Paragraphs.Last.Next.Range .InsertBefore vbCr .Paste End With Next End With End With Next End With Application.ScreenUpdating = True End Sub |
#25
|
||||
|
||||
The code in post #14 doesn't create a duplicate table or move any data - it simply reformats the existing tables.
Although you're now proposing to use code based on that from post #8 for the malformed tables, there'd be no sensible way to create a new ones based on them and transfer the data - one simply couldn't guarantee the outcome would be anything like what is needed. Best to fix the problem tables before running the macro from post #14 against them.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
column width, combine, tables |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Table will not allow sorting because "cells are merged". I can't find the merged cells. | wendyloooo | Word Tables | 1 | 05-26-2015 01:19 PM |
Splitting one column into two with two different widths | officeboy09 | Excel | 6 | 12-15-2013 09:48 PM |
Pasting tables from Excel 2010 into Word 2010 - How to fix column widths? | GracieB | Word | 7 | 10-02-2013 06:24 AM |
Adjusting column widths | norwood | Word VBA | 0 | 09-24-2013 06:53 AM |
VBA code to fix column widths | molesy | Excel | 3 | 09-16-2013 12:51 PM |