I have a table in Word and I need to move certain rows to the bottom of the table using VBA.
I know I can do this by cutting and pasting (myTable.Rows(2).Select ... Selection.Cut ... etc.) but I don't want to have to use the clipboard.
Although I can manually highlight the row and drag it using the mouse, when I record a macro, the drag is not allowed and there does not seem to be any obvious menu instruction to carry out the equivalent.
The only other thing I can think of doing is (using VBA):
Add a new row at the bottom
Replicate the data in the new row from the one to be moved
Delete the original row
A "sexier" solution to this must be out there ;)
Here are two things you could explore:
Use FormattedText:
Sub moverow4table1toend()
Dim source As Word.Range
Dim target As Word.Range
Dim t As Word.Table
Set t = ActiveDocument.Tables(1)
Set target = t.Range
target.Collapse wdCollapseEnd
Set source = t.Rows(4).Range
target.FormattedText = source.FormattedText
source.Rows(1).Delete
Set source = Nothing
Set target = Nothing
Set t = Nothing
End Sub
Or perhaps if you are actually doing something more like sorting, you could add a column (assuming you haven't reached the limit, populate it with the destination row numbers, sort the table, and remove the column.
Related
I'm trying to use VBA WordEditor to compile an Outlook e-mail which copies some tables from a workbook and pastes them into the e-mail. I'm trying to make the table objects lie on the same horizontal line to one another. My code is able to place them side by side, but one table is slightly lower then the other and I have tried but failed to move it upwards.
The code below what I'm currently using to test run the pasting process - note it is intended to be looped so that I can paste multiple tables, right now however I'm just trying out with 2.
Here's an example of what it outputs
Here's an example of what I want to achieve. Here I can only do this by manually dragging the table.
Dim tblScore2, tblScore1 As Word.Table
Dim rngTarget, rngHolder As Word.Range
Dim ws_sum As Worksheet
dim wdDoc as Word.Document
''''''
'some other code here
''''''
With ws_sum
.Range(.Cells(9, 3), .Cells(12, 7)).Copy
End With
Set rngTarget = wdDoc.Range(0, 0)
Set rngHolder = rngTarget.Duplicate
rngTarget.InsertBefore vbCr
rngTarget.MoveStart wdCharacter, 1
rngTarget.Paste
rngHolder.InsertBefore vbCr
Set rngTarget = rngHolder.Duplicate
rngTarget.Collapse wdCollapseEnd
rngTarget.Paste
Set tblScore1 = wdDoc.Tables(1)
Set tblScore2 = wdDoc.Tables(2)
tblScore1.Rows.WrapAroundText = True
tblScore2.Rows.WrapAroundText = True
'was trying to make this work but it hasn't yielded any results..
tblScore2.Range.Move wdParagraph, -2
I've tried changing the table properties, i.e. Rows.Alignment, .HorizontalPosition but none of them seem to even elicit a response, aside from .Alignment which only shifts the table left and right in the specified direction but still does not change the height difference - what is interesting is perhaps when editing the horizontal position of the tables in word, it does indeed produce the response I wanted, but its only when I am working in Outlook that it doesn't work. I've come to suspect it has something to do with the tables lying on different paragraphs, but trying .Move and .MoveUp has not worked out either. Any suggestions would be appreciated!
I'm trying to organise my columns in some VBA code. I need them in a particular order depending on the value in Row A. I know i can do it using the following method but it's very long winded and looks horrible. Is there any more efficient way to do it?
Current Code
Set Name = Cells.Find(What:="Name", LookAt:=xlWhole)
Then activate the cell, find column and then paste to where i want it. So if the columns went like this:
It would change the order to this
I can't just delete the columns that I don't want because they change position. So if i was to delete columns C:C it might delete what i need on occasion.
I need it so that no matter what columns are there, or how many, it will also go in the same order as shown above.
Thanks
Try this.
Dim Rng As Range
Set Rng = ActiveSheet.UsedRange
If Range("A2").Value = "x" Then
Range("A1,C1,D1").EntireColumn.Hidden = True
Rng.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet2").Range("A1")
End If
Related to my question in determining how to see if a shape has overflowed a page boundary (Determining if a powerpoint text box is over the page size)
I need to move rows of a table on one page to the prior page.
Fairly straightforward to determine the rows I need to cut (I've left that part of the code out for brevity). Where I am having a problem is the method of how to paste it back into the table on the prior page (table has same column dimensions).
In the UI, it is as simple as placing the cursor in the first cell of the target row and hitting paste. This completely replicates the column structure of the cut row. In VB, best I can do is paste the entire text of the cut row (all columns) gets into the one cell. I cant seem to get VB code that can replicate what is happening in the UI. What command am I missing?
For y = 2 To c
Set oSh = ActivePresentation.Slides(k + 1).Shapes("ProgTable")
With oSh.Table
.Rows(y).Select
End With
Windows(1).Selection.Cut
Set oSh = ActivePresentation.Slides(k).Shapes("ProgTable")
With oSh.Table
.Rows.Add (-1)
.Cell(oSh.Table.Rows.Count,1)textFrame.TextRange.Paste 'pastes all columns into the one cell
End With
Next y
Alternate line of code to paste clipboard that I can't get to work
.Rows(oSh.Table.Rows.Count).Cells.Item.Shape.TextFrame.TextRange.PasteSpecial (PpPasteDataType.ppPasteHTML)
'does not work, gives compile error on ITEM argument not optional
You're pasting in to a TextRange, not the table/row itself. There are some funky things in PPT's object model for sure, and some actions which seem like they should be intuitive (copy/paste) often are not. In these cases, the Application.CommandBars.ExecuteMSO method is usually where I start (also very useful if you're copying from/between different applications like Excel>PowerPoint, Word>PowerPoint, etc.)
I did this to test, and it is working as expected, so it should set you on the right track:
Sub CopyRowToAnotherTable()
Dim tbl1 As Table
Dim tbl2 As Table
Dim sld1 As Slide
Dim sld2 As Slide
Dim pres As Presentation
Dim shp As Shape
Set pres = ActivePresentation
Set sld1 = pres.Slides(1)
Set sld2 = pres.Slides(2)
Set tbl1 = sld1.Shapes(1).Table
Set tbl2 = sld2.Shapes(1).Table
'Cut the last row from tbl2:
sld2.Select '## Powerpoint requires the slide to be active/view in order to select shapes on the slide
With tbl2
.Rows(.Rows.Count).Select
pres.Windows(1).Selection.Cut
End With
'Insert in tbl1
With tbl1
.Rows.Add -1
sld1.Select
.Rows(.Rows.Count).Select
pres.Application.CommandBars.ExecuteMso "Paste"
End With
End Sub
So in your code, I think this should work:
With oSh.Table
'## select the slide:
.Parent.Parent.Select
.Rows.Add (-1)
.Rows(.Rows.Count).Select
Application.CommandBars.ExecuteMso "Paste"
End With
The tricky part about the ExecuteMso method is mainly that it's not well-documented, or it is, but it's hard to find the dox, so here is reference from a previous answer:
Documentation on the ExecuteMso method:
http://msdn.microsoft.com/en-us/library/office/ff862419.aspx
Downloadable document containing the idMSO parameters for each Office
Application:
http://www.microsoft.com/en-us/download/details.aspx?displaylang=en&id=6627
I have a word document with several tables.
The first table in the document is supposed to be a summary table containing copies of certain rows of the other tables in the document.
How would I have to tackle the automated population of the summary table with the specific rows of the other tables?
I assume there is no built in function and I'd have to use VBA.
I'd think I have to mark the rows to be copied with some marker (e.g.: "###") for the code to detect. Then the code would have to go through the document, find all the "###", mark them as "dealt with" (e.g., with "##-") and copy/append the respective row into the first table, and then loop through the document again.
You can mark the row(s) using bookmarks; name them with a special prefix. Loop through the bookmarks collection, check the prefix and if it's the correct one, append the row to the sumamry table. You can delete the bookmark in the process, if you wish.
Here's some sample code which works for me in a quick test. The boomkark prefix is "tbl"; if you don't want it to be visible to the user, start the name with an underscore (_).
The target range for the summary table is at the start of the document. Change the assignment to the rng object if you need it elsewhere.
Dim doc As word.Document
Dim rng As word.Range
Dim rwSource As word.Row
Dim bkm As word.Bookmark
Set doc = ActiveDocument
Set rng = doc.Range(0, 0)
For Each bkm In doc.Bookmarks
If Left(bkm.Name, 3) = "Tbl" Then
rng.FormattedText = bkm.Range.FormattedText
rng.Collapse wdCollapseEnd
End If
Next
Note: I tried using REF fields to pick up the bookmarked rows, without needing VBA. This inserted an empty row between each REF field, however, so I don't think it can be done without VBA.
I need a way to programatically adjust an entire row in an excel table based on the ActiveCell, irrespective of what table it's in or where the table is. I was using
ActiveSheet.ListObjects(1).ListRows(ActiveCell.Row - 1).Range.Select
Selection.Style = "Good"
but upon shifting the table down five rows, it now applies the action down a further five rows from the ActiveCell.
I've tried finding a way to replace the - 1 with some sort of - .HeaderRowRange.Row but nothing happens when I activate the macro.
You can take advantage of the ActiveCell.ListObject property. This makes it more flexible, e.g., if there's two tables in a worksheet:
Sub FormatActiveTableRow()
Dim lo As Excel.ListObject
Set lo = ActiveCell.ListObject
If Not lo Is Nothing Then
Intersect(ActiveCell.EntireRow, lo.Range).Style = "Good"
End If
End Sub
If I understood the problem correctly, try using the following code and report back:
ActiveSheet.ListObjects(1).ListRows(ActiveCell.Row - ActiveSheet.ListObjects(1).HeaderRowRange.Row).Range.Select