I wrote a macro which copies table from excel to word. In excel all columns have different width. In Word I want to fit my table to one page - margins in Word are 1.5 cm from left and right. Number of rows in my table changes, number of columns is stable (this is 14). How can I set column width to be equal? I wonder if it's possible to set the same column width regardless of the amount of text in headlines. I create swdth variable which I then divide by 14 (all my columns) and I have my table on one page...
This code doesn't work properly. I have all rows in one page, but columns have different width.
Table.Rows.SetHeight RowHeight:=InchesToPoints(0.17), HeightRule:=wdRowHeightExactly
Table.Rows(1).SetHeight RowHeight:=InchesToPoints(0.59), HeightRule:=wdRowHeightExactly
sWdth = InchesToPoints(6.22)
WordTable.PreferredWidthType = wdPreferredWidthPoints
WordTable.PreferredWidth = sWdth
sWdth = sWdth / 14
Giving all columns the same with is as simple as:
Table.Columns.DistributeWidth
but it's not apparent what this has to do with keeping the table on one page.
I've seen similar questions recently. As always...
#1) Turn on the Macro Recorder
#2) Click through the steps you need to perform
#3) Turn off the Macro Recorder
Hit Alt+F11 and you should see all the code you need to do whatever you want to do. Remember, the Macro Recorder is your friend!
Related
I'm really a beginner at vba, but I've been puzzling around how to make it work. I'm creating a powerpoint presentation with Excel vba, based on data in an excel sheet a table is created on a slide in a newly created powerpoint presentation. I've got the table formatting done, which is a real hassle, by going over each individual cell and formatting them (looping, but still)....
The only thing missing is the individual column width. Based on the input data some columns might change in width,
Because of this reason I would like to have an autofit on the columns only. The rows should remain 1 line in height. But the column width should adapt to whatever would be necessary to keep the row height on 1 line.
Dim PPTtable1 As PowerPoint.Shape
With PPTtable1
.Left = 350
.Top = 150
.Width = 758
.table.Columns(1).Width = Auto
.table.Columns(2).Width = Auto
.table.Columns(3).Width = Auto
End With
This would turn the columns in the smallest possible width by stretching the height of the cells. Basically what I need is the function of double clicking on the side border of a column, and it will automatically fit to the correct width.
EDIT:
Maybe this would be interesting and important to know the order of the code:
Table is created
Format of the individual cells (bold, italic, size, font, etc...)
Data is filled in from an excel sheet
Trying to autosize the column
I want to change the font of all even rows in a large table in Microsoft Word (most versions, I use 2014) to red
I tried a simple loop :
For ii=2 to ActiveDocument.Tables(1).Rows.Count step 2
ActiveDocument.Tables(1).Rows(ii).Select
Selection.Font.ColorIndex = wdRed
Next
This sometimes hangs, sometimes it works, but takes hours (my table has 14000 rows...)
Then I had the idea : Manually, I can select a row by left-clicking on its left, then add additional rows to the selection by Ctrl-left-click on their left.
And I can then modify the font of all rows selected at once.
So let's see if doing the same programmatically is faster ! I tried something like
ActiveDocument.Tables(1).Rows(2).Select
For ii=4 to ActiveDocument.Tables(1).Rows.Count step 2
Selection.Add (ActiveDocument.Tables(1).Rows(ii))
Next
Selection.Font.ColorIndex = wdRed
but Add is not accepted as a valid Selection object member
Can someone help there ?
define a new style and apply it to the table ... no vba needed
this is a macro recording of an example style change ... if you wish to use vba
Selection.Tables(1).Style = "Grid Table 5 Dark - Accent 2"
also, record a macro of doing a new style definition .... lots of good stuff in it
I have a large macro that generates and populates a table in powerpoint based on excel values. I manually resize the rows based on specific parameters, but I've run into the very annoying issue that I cannot seem to prevent the rows from auto-resizing if the text would overflow from that particular cell. I've tried using the textframe and textframe2 "autosize" property but this gives an error on the first call saying that the specified value is out of range. The error number is -2147024809 (80070057), although I doubt that will be of any use. Is there a way to prevent this autosizing beyond writing code to manually shorten the text when it will overflow?
RGA,
the answer to your question is yes; you can do this. This topic is discussed in the following thread: Understanding format of tables in PowerPoint (VBA 2010) (resize text to cell)
However, I don't know if this technique still 'works' for ppt 2016. I had such code implemented, and then I 'upgraded' to office 2016; now it doesn't work.
With that being said, this was my code (resized the text until it 'fit'):
...
Do Until (table.rows(1).height + table.rows(2).height < TABLE_HEIGHT) or (table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size = 1)
If table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = 1 Then
table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = 27
table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size = table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size - 1
table.Cell(2, 3).Shape.TextFrame.TextRange.Font.size = table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size
Else
table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size - 1
End If
Loop
In order to restore some functionality in ppt 2016, I decided to rewrite my code to limit the number of lines shown to prevent the 'resize' table call:
...
table.Cell(1, 1).Shape.TextFrame.TextRange = table.Cell(1, 1).Shape.TextFrame.TextRange.lines(1,2)
table.Cell(2, 2).Shape.TextFrame.TextRange = table.Cell(2,2).Shape.TextFrame.TextRange.lines(1,1)
table.Cell(2, 3).Shape.TextFrame.TextRange = table.Cell(2, 3).Shape.TextFrame.TextRange.lines(1,1)
In theory, you can use the .height; .Textrange; and the height of your font to figure the size of font you need inorder to 'shrink' the text to fit.
What do you want to happen when there is too much text to fit into a cell? There is no UI concept in PowerPoint to prevent row auto resizing based on cell overflow as there is nowhere for the additional text to go as demonstrated by typing in a cell within PowerPoint. Therefore there is no API to do the same. I would record the row before and after inserting the text and truncate word by word as you say until the row height returns to the original value.
I am new in VBA, and I got a task to find a way to implement the 5 stars review like in Amazon/Ebay with graphical stars itself for an excel table. Is it possible that? or even to combine with other technologies.
All I need are some hits, how to do that, and where to start.
Based on your last comment I would like to merely sketch the basic concept of doing such rating manually. Since I couldn't fit it in a comment box I'll put it here as a conceptual draft of what it might look like (this is not an attempt to be a solution):
(1) Getting a star on a sheet is as simple as that
Sheet1.Shapes.AddShape Type:=msoShape5pointStar, _
Left:=100, Top:=100, Width:=7.2, Height:=7.2
(2) Getting four more stars next to it should be simple enough by adding the width of prior star(s) and some extra space to the Left.
(3) Color your star(s) yellow or white with presets (Office 2010+)
.ShapeStyle = msoShapeStylePreset12
(4) In order to locate the stars on the sheet next to the cell containing the value which should be rated you can use the following methods assuming that the value is in cell A1:
.Left = Sheets(1).Range("A1").Left + Sheets(1).Range("A1").Width
Of course, there is a bit more to it than the above. You will have to determine the range of cells for which you want to create stars. Also, if someone adds a column or changes the width of a column then all stars might get changed and will have to be drawn again. Also, you'll have to make sure that the column B is wide enough to hold all the stars. But that's the basic concept (as I would attempt to do it).
I have one Chr(10) in the cell
cell.WrapText = False
cell.EntireRow.AutoFit ' AutoFit works
' ------------ but:
cell.WrapText = True
cell.EntireRow.AutoFit ' AutoFit works only if the cell has less then five lines.
If I add some characters (one line more) - AutoFit doesn't work. Text is cutted on the first and last line.
ver - famous excel 2010
It depends on how big the data is and what is the width of the column. Reason being the max height a row can expand is to 409.5 (546 pixels). If you manually increase the height of the row, you will notice that after a particular height, you will not be able to increase the height of the row. Check what is that height :) Same is the concept with the width. This is applicable to both rows and columns. In case of columns the max width is 254.86 (1789 pixels)
I used this code for demonstration purpose.
Option Explicit
Sub Sample()
ActiveCell.WrapText = True
ActiveCell.EntireRow.AutoFit
MsgBox ActiveCell.RowHeight
End Sub
See this screenshot
This works
This doesn't
The row has reach it's maximum. It cannot go beyond that.
The best way to handle this is to increase the width of the column.
FOLLOWUP
The reason why it was not working is because you had multiple columns with data in that row and you were trying to just set the WrapText of 1 cell and hence it was not working. When you have multiple columns of data you have to use cell.EntireRow.WrapText = True instead of ActiveCell.WrapText = True
A related solution in case it helps someone. I have data with 'Wrap Text' on and line breaks in cells that come from copying data from formulas that used 'Char(10)'. I need the line breaks.
For example, data in a cell should show like this:
City: New York (1950)
Country: USA
But it showed something like this:
City: New
York (1950)
Country:
USA
Selecting the column and clicking to autofit resulted in slight improvement:
City: New York
(1950)
Country: USA
Repeating manual auto-fit a 2nd time brings text to desired format.
If there is more space-separated text in a line, it takes that many more auto-fit attempts, and eventually format is fully corrected.
So in my VBA code, I replicated this and repeated auto-fit code the number of times I knew would fix my issue:
'Adjust column Width
wsSched2.Columns("F:CZ").EntireColumn.AutoFit
DoEvents
wsSched2.Columns("F:CZ").EntireColumn.AutoFit
DoEvents
wsSched2.Columns("F:CZ").EntireColumn.AutoFit
(It may work without 'DoEvents'. I haven't tried)