I have an Excel Sheet in PPT-Look which is filled with data from another sheet dynamically. Row height for rows 1 to 7 and from 30 to 36 are fix (header & footer of the ppt). In range from row 8 to 26, rows are hidden when empty (I entered white "X" to some of the rows to keep them shown).
I need to get a total height of 721px for the rows 2 to 36 to fit onto my PPT-Template when exporting it.
Is there a possibility to dynamically adapt row height of a "white" row (as for example row 29) to get a total of 721px for the defined range (row 2 to 36)?
you could go like follows:
Option Explicit
Sub main()
Dim extraRowHeight As Double, totalRowsHeight As Double
Dim myRowsRange As Range
Const maxRowHeight As Double = 409 '<--| maximum allowed row height
totalRowsHeight = 721# '<--| set the total rows height you need for the range you are to specifiy right below
With Worksheets("MyTableSheet") '<--| change "MyTableSheet" with your actual sheet name
extraRowHeight = totalRowsHeight - .Rows("2:36").Height '<--| calculate the extra height needed for the wanted rows range
With .Rows(29) '<--| consider the "reservoir" row
If .RowHeight + extraRowHeight <= maxRowHeight Then '<--| if needed extra height leads to an allowable resulting "reservoir" row height ...
.RowHeight = .RowHeight + extraRowHeight '<--| ... then adjust "reservoir" row height
Else
.RowHeight = maxRowHeight '<--| ... otherwise adjust "reservoir" row to maximum allowable height ...
MsgBox "you still need to resize some other rows height for " & totalRowsHeight - .Rows("2:36").Height & " pts more" '<--|... and inform how much there still is to go
End If
End With
End With
End Sub
Related
I am New to VBA. I have a table with 4 columns and almost 2000 rows and it is displayed in a 3 column Word layout. My problem is that the last rows of the 3 columns are not always on one height as shown in the image (Masked the personal data with the white font in cells). [Image of the Table1
I think a solution would be to set the height of the rows with 2-lines to 0.54cm and the 1-line rows to 0.27cm. I did this manually and it worked. I am looking for a macro to achieve this. The below code will provide an understanding of what I am trying to do.
Sub height ()
ActiveDocument.Tables(1).Rows.HeightRule = wdRowHeightAuto
'this automatically sets the 2-line rows to 0.53cm and the 1-line rows to 0.25cm
For Each row in Rows
If Row.RowHeight < 0.5cm Then
Row.RowHeight = 0.27cm
Else Row.RowHeight = 0.54cm
End If
Next Row
End Sub
I know that this code cant work but i think it shows you what i want to do.
As Row.RowHeight won't return a useful value unless the row has been set to an exact height you can change the line spacing for the text so that the required cell heights are achieved automatically.
The code below assumes that the table you want to adjust is the first one in the document.
Sub AdjustLineSpacingForTable()
Dim reqdLineSpacing As Single
'start with the height of a double height cell
reqdLineSpacing = CentimetersToPoints(0.54)
With ActiveDocument.Tables(1)
'table cells have padding top and bottom so we need to subtract that from the required height
reqdLineSpacing = reqdLineSpacing - (.TopPadding + .BottomPadding)
'now we can adjust the text spacing
With .Range.ParagraphFormat
'ensure there is no additional spacing on the paragraphs
.SpaceAfter = 0
.SpaceBefore = 0
'set line spacing to an exact amount
.LineSpacingRule = wdLineSpaceExactly
.LineSpacing = reqdLineSpacing / 2
End With
End With
End Sub
I have used the Range.end property for achieving my target of setting the data into a table cell into particular number of lines.
For this first I calculate the instant cell height then keep on changing the cell width to achieve targeted cell height.
This property, when used in step by step execution, is giving the correct value, and I am able to achieve the targeted cell height. Range.end keeps on returning the same value even after the change in cell height, which must have changed the range.end value
'the table acted upon has 2 rows and one column and the column width as already 'set to some small value
With ActiveDocument.Tables(tableIndexTemp + 1)
'calculate cell height
posEnd = .Cell(1, 1).Range.End - 1
heightDaisRow = ActiveDocument.Range(posEnd, _ posEnd).Information(wdVerticalPositionRelativeToTextBoundary)
Do While heightDaisRow > minHeightDaisRow
'increase cell width
.Columns(1).Width = .Columns(1).Width + CentimetersToPoints(0.1)
'again calculate cell height
posEnd = .Cell(1, 1).Range.End - 1
heightDaisRow = ActiveDocument.Range(posEnd, _ posEnd).Information(wdVerticalPositionRelativeToTextBoundary)
Loop
End With
When executed step by step the value of posEnd changes with the change in width but when the same code is executed in one go the posEnd value does not change, which causes the cell width to keep on increasing and shows the error
Cell width can not be more than this particular value'.
Looking at the bottom of this code, I need to call upon a range and the range needs to be the position of the maximum value. Is there a way to store that position of that value into a variable and then use that variable as the range?
Dim Retest As Boolean
If (Abs(Suspect - mean) / SD) > LowConf Then
MsgBox "95% outlier: " & Suspect
Retest = True
End If
If (Abs(Suspect - mean) / SD) > HighConf Then
MsgBox "99% outlier: " & Suspect
Retest = True
End If
If Retest = True And Suspect = Application.WorksheetFunction.Max(DataSet) Then
Range(?).Delete Shift:=xlUp
End If
Finding the position of the maximum value of the range A1:A10 and highlighting the value. Try the below example and modify it per your needs,
Sub find()
Dim i As Long, rownum As Integer
' variable i contains the max value of range A1:A10
i = Application.WorksheetFunction.Max(Range("A1:A10"))
' rownum is the row number of the maximum value
rownum = Application.WorksheetFunction.Match(i, Range("A1:A10"), 0)
' use the rownum and highlight the cell
Range("A" & rownum).Interior.Color = vbGreen
End Sub
This vba code uses the match function to find the row number of the max value and use it in a range.
What I want to do is create a macro to look at a column (AF) and based on that value, compare column (BI), (BJ), and/or (BK) together and if its false, highlight the compared cells in yellow. I know that's a little hard to follow but this example should help clarify:
My Sheet has the following columns:
Column AF Column BI Column BJ Column BK
PRODUCT Height Length Width
I need a macro to look at the product type and compare the dimensions for that product as follows:
- If product = A, then Length = Width, if not then highlight Length and Width Cells
- If product = B then Length > Width, if not then highlight Length and Width Cells
- If product = C then Width > Height < Length, if not highlight Length, Width, and Height cells
- If product - D then Width = Length < Height, if not highlight Width, Length, and/or Height
My Data starts on row 3 and ends at row 5002.
I have tried researching this and was only able to find solutions that compare two cells then write a third column. I could combine an IF formula and conditional formatting to achieve this but I don't want to have this run all the time as the sheet will be sorted and color coded. I plan to place this macro into a command button.
Suggest to combine Statements such as Select Case, If...Then...Else, together with Operators And, Or. See the following pages:
https://msdn.microsoft.com/en-us/library/office/gg251599.aspx
https://msdn.microsoft.com/en-us/library/office/gg278665.aspx
https://msdn.microsoft.com/EN-US/library/office/gg251356.aspx
After which you should be able to write something that resembles this:
(Code below is just a sample, it will not work)
Select Case Product
Case A
If Length <> Width Then
Rem Highlight Length And Width Cells
End If
Case B
If Length <= Width Then
Rem Insert here the code to highlight Length And Width Cells
End If
Case C
If Width <= Height And Height >= Length Then
Rem Insert here the code to highlight Length, Width, and Height cells
End If
Case D
If Width <> Length And Length >= Height Then
Rem Insert here the code to highlight Width, Length, and/or Height
End If
End Sub
In case you don’t know to highlight the Width, Length and Height Cells; I suggest to do it manually while recording a macro, this shall give a good starting point.
I suggest to work with objects, defining variables for the Data range, each row being validated, the position of the fields to validate, etc. see below code with comments
Sub Highlight_Cells_based_Comparison()
Dim rData As Range
Dim rRow As Range
Dim rCllsUnion As Range
Rem Set variables to hold Fields position within the DATA range
Dim bPosProd As Byte, bPosHght As Byte, bPosLeng As Byte, bPosWdth As Byte
Rem Set variables to hold Fields values
Rem (data type Variant as don't know type of values these fields are holding, change as appropriated)
Rem see https://msdn.microsoft.com/en-us/library/office/gg251528.aspx)
Dim sProd As String, vHght As Variant, vLeng As Variant, vWdth As Variant
Dim lRow As Long
Rem Set Range (assuming it goes from column C to BK - change as needed)
Rem Not starting from column A on porpuse
Set rData = ActiveSheet.Range("C3:BK5002")
Rem Get Fields position from Header row
Rem Suggest to use this method instead of hard coding columns
On Error Resume Next
With rData
bPosProd = WorksheetFunction.Match("PRODUCT", .Rows(1), 0)
bPosHght = WorksheetFunction.Match("Height", .Rows(1), 0)
bPosLeng = WorksheetFunction.Match("Length", .Rows(1), 0)
bPosWdth = WorksheetFunction.Match("Width", .Rows(1), 0)
End With
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
Rem Loop thru each row excluding header
For lRow = 2 To rData.Rows.Count
Set rRow = rData.Rows(lRow)
With rRow
Rem Get Row Field values
sProd = .Cells(bPosProd).Value2
vHght = .Cells(bPosHght).Value2
vLeng = .Cells(bPosLeng).Value2
vWdth = .Cells(bPosWdth).Value2
Select Case sProd
Case A 'Change value of A as required
Rem If product = A, then Length = Width, if not then highlight Length and Width Cells
Rem If Length <> Width Then Highlight Length And Width 'Cells
If vLeng <> vWdth Then
Set rCllsUnion = Union(.Cells(bPosLeng), .Cells(bPosWdth))
Rem Suggest to use a subroutine for this piece as it's a repetitive task
Rem see https://msdn.microsoft.com/en-us/library/office/gg251648.aspx
GoSub CllsUnion_Highlight
End If
Case B
Rem repeat as in Case A with required changes
Case C
'...
Case D
'...
End Select: End With: Next
Exit Sub
Rem Subroutine to highlight cells
CllsUnion_Highlight:
With rCllsUnion.Interior
.Color = 65535
.TintAndShade = 0
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.PatternTintAndShade = 0
End With
Return
End Sub
I've looked all over the place and tried various things. It's been assumed that it can't be done. So I'm going to try here and see if anybody else has had any luck.
Is there any way to get the height of a table row in Word when the row's HeightRule is set to wdRowHeightAuto?
Alternatively, if there's a way to get the cell's height instead, I'll accept that as a solution since you can calculate the row's height by finding the row's biggest cell.
It's possible to find the row height with Range.Information(). The following snippet doesn't work for the last row in a table or the last row on a page
Dim Tbl as Table
Dim RowNo as Integer
Dim RowHeight as Double
' set Tbl and RowNo to the table and row number you want to measure
RowHeight=Tbl.Rows(RowNo+1).Range.Information(wdVerticalPositionRelativeToPage) _
- Tbl.Rows(RowNo).Range.Information(wdVerticalPositionRelativeToPage)
This returns the height of the row in points by calculating the difference in position between the selected row and the following one.
I have a routine which works in all cases and returns the height in points of the second and subsequent lines in a cell, i.e. a single-line cell returns 0. (I use this in an application which reduces the font size in certain cells to fit the text on one line.)
Dim Doc As Document
Dim Tbl As Table
Dim Pos As Long
Dim RowNo As Integer
Dim ColNo As Integer
Dim CellHeight As Single
' set Doc, Tbl, RowNo and Colno to the document,table and row number you want to
' measure or provide a cell's range if you prefer
Pos = Tbl.Cell(RowNo, ColNo).Range.End - 1 ' last character in cell
CellHeight = Doc.Range(Pos, Pos).Information(wdVerticalPositionRelativeToTextBoundary)
How about cheating?
Dim tbl As Word.Table
Dim r As Row
Dim c As Cell
Set tbl = ActiveDocument.Tables(1)
For Each r In tbl.Rows
iHeight = r.HeightRule
r.HeightRule = 1
Debug.Print r.Height
r.HeightRule = iHeight
Next
I tried the above and found that changing the HeightRule changes the height of the row, which given I am trying to "freeze" the height on what appears in my table beforehand, makes nonsense of the above.
For rows which are empty or contain a single paragraph of unwrapped text in a consistent paragraph format adding up the font size, para before and after can work as follows:
Set r = c.Row
With r
If .HeightRule <> wdRowHeightExactly Then
.HeightRule = wdRowHeightExactly
Set p = c.Range.ParagraphFormat
.Height = c.BottomPadding + c.TopPadding + p.SpaceBefore + p.SpaceAfter + p.LineSpacing
End If
End With