I am working on a function that allows me to insert a specific number of rows below a specific row in my powerpoint table. Please note that this is no standard table - it has a format in which there is one "Content Row". After, there are 2 small (height) white rows before a next "Content Row" follows. The white rows are merely for optics and have a border in between.
The code is working well, however the very last operation at the bottom - to display the border in between the rows - does not work. Simply no border appears.
Thank you SO much for any input you can provide! <3
Private Sub Insert_Click()
'Read Input from UserForm
Answer1 = UserForm1.Answer1.Text
Answer2 = UserForm1.Answer2.Text
Unload UserForm1
'Analyze Row prior operation
SmallHeight = ActiveWindow.Selection.ShapeRange.Table.Rows(2).Height
For repeat = 1 To Answer2
'Add Row
'Paster after row
BelowRow = 1 + 3 * (Answer1 - 1)
For i = 1 To 5
ActiveWindow.Selection.ShapeRange.Table.Rows.Add (BelowRow)
i = i + 1
Next
'Format "BelowRow" with Font and Text
With ActiveWindow.Selection.ShapeRange.Table.Cell(BelowRow, 1).Shape.TextFrame.TextRange
.Text = "Insert Caption"
.Font.Name = "Arial"
.Font.Size = "12"
End With
'Format two rows below "BelowRow"
intTableCols = ActiveWindow.Selection.ShapeRange.Table.Columns.Count
For r = 1 To 3
BelowRow = BelowRow + 1
For c = 1 To intTableCols
With ActiveWindow.Selection.ShapeRange.Table.Cell(BelowRow, c).Shape
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 1
.TextFrame.TextRange.Font.Size = "1"
.TextFrame.MarginBottom = 0
.TextFrame.MarginLeft = 0
.TextFrame.MarginRight = 0
.TextFrame.MarginTop = 0
End With
Next
'Reduce Row Height
ActiveWindow.Selection.ShapeRange.Table.Rows(BelowRow).Height = SmallHeight
r = r + 1
Next
BelowRow = BelowRow - 1
'Add Border and Format
With ActiveWindow.Selection.ShapeRange.Table.Rows(6).Cells.Borders.Item(ppBorderTop)
.Weight = 3
.ForeColor.RGB = RGB(77, 77, 77)
End With
Next
End Sub
Related
I'm trying to loop through an "ordered" list to create several rectangle shapes in hierarchy style (and link them with elbow connectors). Example: on my WBSdata sheet, I have the following
A B
1 0. Box 0. lvl1
2 0.1. Box 0.1. lvl2
3 Comment 1
4 Comment 2
5 0.1.1. Box 0.1.1. lvl3
6 Comment 1
7 Comment 2
8 Comment 3
9 0.2. Box 0.2. lvl2
10 0.2.1. Box 0.2.1. lvl3
11 0.2.2. Box O.2.1. lvl3
12 Comment 1
13 Comment 2
14 1. Box 1. lvl1
15 Comment 1
16 Comment 2
17 1.1. Box 1.1. lvl2
Would output something like this on the WBS sheet:
Basically, read the "index" in column A, if it's first level (2 characters in column A), draw a blue box and write the corresponding value from column B, then look at the line below, if it's a level 2 box (4 characters), draw it below (a bit shorter on the left side), assign it the value ; same for lvl 3 box. If column A i empty, create a text box below the shape, and add all the comments.
So far (see code below), I managed to create a box (yay), style it and add the text, as well as create a text box (with a line on the side, like in the picture, but i'd need it to be the same "dynamic" height as the text box), but i can't get it to add all the comments. I can't get the magic to understand that it needs to move to the next "level" (go from blue box to green box for example).
I haven't yet tried to connect each box to its "hierarchical superior", but that's another story :)
I'm pretty sure i'm not managing my variables correctly (mainly the counter), making it reset at the right time, etc...
Any tips to send me on the right direction?
Public Sub wbsShape()
Dim wbs, wbsdata As Worksheet
Set wbs = ThisWorkbook.Sheets("WBS")
Set wbsdata = ThisWorkbook.Sheets("WBSdata")
i = 2 'counter, because data starts on line 2
ileft = 100 'initial position from left of sheet
itop = 100 'initial position from top of sheet
lg = 175 'main box width
ht = 50 'main box height
ind = 10 'indent (for lines, or smaller boxes)
impred = RGB(128, 0, 0) 'red
impgreen = RGB(0, 128, 0) 'green
impblue = RGB(0, 0, 128) 'blue
impgrey = RGB(200, 200, 200) 'light grey for border
black = RGB(0, 0, 0)
white = RGB(255, 255, 255)
Do While Not IsEmpty(wbsdata.Cells(i, "A").Value)
With wbs.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
.Fill.ForeColor.RGB = impblue
.Line.ForeColor.RGB = impgrey
.Line.Weight = 1
.Name = wbsdata.Cells(i, "B").Value
With .TextFrame
With .Characters
.Text = UCase(wbsdata.Cells(i, "B").Value)
With .Font
.Color = white
.Name = "Arial"
.Size = 14
.FontStyle = "Bold"
End With
End With
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
i = i + 1
If IsEmpty(wbsdata.Cells(i, "A").Value) Then
wbs.Shapes.AddLine(ileft + ind, itop + ht, ileft + ind, itop + ht + 100).Line.ForeColor.RGB = RGB(10, 10, 10)
With wbs.Shapes.AddTextbox(msoTextOrientationHorizontal, ileft + 2 * ind, itop + ht, lg - ind, 30)
.Line.Visible = msoFalse
.Fill.Transparency = 1
With .TextFrame.Characters
.Font.Name = "Arial"
.Text = wbsdata.Cells(i, "B").Value
End With
End With
End If
itop = itop + ht + 20
Loop
End Sub
I think this is going to be a lot of work (I've stripped out a lot of your formatting), but perhaps this will start you off in the right direction.
Sub x()
Dim r As Range, v, s As Shape
ileft = 100 'initial position from left of sheet
itop = 100 'initial position from top of sheet
lg = 175 'main box width
ht = 50 'main box height
ind = 10 'indent (for lines, or smaller boxes)
impred = RGB(128, 0, 0) 'red
impgreen = RGB(0, 128, 0) 'green
impblue = RGB(0, 0, 128) 'blue
impgrey = RGB(200, 200, 200) 'light grey for border
black = RGB(0, 0, 0)
white = RGB(255, 255, 255)
For Each r In Range("A1:A4")
v = Split(r, ".")
If UBound(v) = 1 Then
Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
s.Fill.ForeColor.RGB = impblue
s.TextFrame.Characters.Text = r.Offset(, 1)
itop = itop + 75
ElseIf UBound(v) = 2 Then
Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ileft, itop, lg, ht)
s.Fill.ForeColor.RGB = impgreen
s.TextFrame.Characters.Text = r.Offset(, 1)
itop = itop + 75
ElseIf r = vbNullString Then
Set s = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ileft + 2 * ind, itop + ht, lg - ind, 30)
s.Line.Visible = msoFalse
s.Fill.Transparency = 1
With s.TextFrame.Characters
.Font.Name = "Arial"
.Text = r.Offset(, 1).Value
End With
itop = itop + 75
End If
Next r
End Sub
Code:
Public Sub HighLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 2 'Color 1
'Dim colorIndex As XlColorIndex: colorIndex = Application.Dialogs(xlDialogEditColor).Show(10)
'MsgBox colorIndex
Do While (Cells(i, 1) <> "")
If (Cells(i, 1) <> Cells(i - 1, 1)) Then 'check for different value in cell A (index=1)
If c = 2 Then
c = 24 'color 2
Else
c = 2 'color 1
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.colorIndex = c
i = i + 1
Loop
End Sub
This code works perfectly and changes color when value in the column changes. But the colors are specified in the code. I want the user to select color of his/her choice.
Output that I am getting with above code:
What I want the code to do:
Open the color palette.User selects a color.Color index is passed to a variable.When value changes, rows is colored alternatively with white & the color selected.
Eg. if user selects blue from palette, the rows will be blue & white with alternate groups.if user selects green from palette, the rows will be green & white with alternate groups.
I tried including this code :
Dim colorIndex As XlColorIndex: colorIndex = Application.Dialogs(xlDialogEditColor).Show(10)
MsgBox colorIndex
palette opens up perfectly, but MsgBox colorIndex gives me -1 as output.
I cant seem to get this to work. Any change in code.?
The Dialogs(xlDialogEditColor) returns True = -1 if a color was selected and False = 0 if the user pressed cancel. To get the selected color use ActiveWorkbook.Colors(10) like in the example below.
Option Explicit
Public Sub ColorPaletteDialogBox()
Dim lcolor As Long
If Application.Dialogs(xlDialogEditColor).Show(10) = True Then
'user pressed OK
lcolor = ActiveWorkbook.Colors(10)
ActiveCell.Interior.Color = lcolor
Else
'user pressed Cancel
End If
End Sub
So for your loop you could use something like …
Option Explicit
Public Sub HighLightRows()
Dim c As Integer
c = 2 'Color 1
Dim i As Long 'integer is too small for row counting!
i = 2
If Application.Dialogs(xlDialogEditColor).Show(10) = True Then
Do While (Cells(i, 1) <> "")
If (Cells(i, 1) <> Cells(i - 1, 1)) Then 'check for different value in cell A (index=1)
If c = 2 Then
c = 10 'color 2
Else
c = 2 'color 1
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.colorIndex = c
i = i + 1
Loop
Else
'user pressed Cancel
End If
End Sub
Bottom Line Fix: Changing my dynamicly named textbox to have a _ separator between the column and row to get rid of the ambiguity of the names.
Previous Code:
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & r, True)
Fix:
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & "_" & r, True)
I have a userform and it has 15 text boxes columns by X rows (dynamic).
The user inputs numbers into the text boxes. Then I want them to hit a Print button on the user form to run the PrintLabel() sub and put those values into a spreadsheet vertically (B24:Bxx). Then have it print out the spreadsheet and return to the userform.
My issue is I can't seem to get the values from the textboxes.
The textbox names are in an multi-dimensional array style format:
PalletNumber & "row" & "column"
So the first row would be PalletNumber0_0 through PalletNumber0_15. The next row will be PalletNumber1_0 to PalletNumber1_15.
Update:
The user enters the value "1234" into a textbox and clicks "Look Up" to run lookup(). This then searches a spreadsheet for the number and gets all the rows that match and puts them into the userform.
Here is the code snippet
For Each c In Worksheets("Sheet1").range("A2:A" & iRowCount)
If c.value = OrderNumber Then
ReDim Preserve aGetData(6, i)
For a = 0 To 6 'Change this for total of columns Our first index will hold each col of data that is why
'it is set to 0 (arrays start at a base of zero, so
'0,1,2,3,4,5 will be each col(A,B,C).
aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
Next a
'Get the data and set it into variables.
ItemNumber = aGetData(5, i)
ItemQty = aGetData(2, i)
'Create "ItemQuantity" text box.
Set cCntrl = PickTicketForm.Controls.Add("Forms.Label.1", "ItemQuantity" & i, True)
With cCntrl
.Caption = ItemQty
.Width = 85
.Height = 18
.Top = 86 + (i * 20)
.Left = 40
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
End With
'Create "ItemNumber" box
Set cCntrl = PickTicketForm.Controls.Add("Forms.Label.1", "ItemNumber" & i, True)
With cCntrl
.Caption = ItemNumber
.Width = 340
.Height = 18
.Top = 86 + (i * 20)
.Left = 86
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
End With
'Create each inputbox for the pallets.
For r = 0 To 14
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & "_" & r, True)
With cCntrl
.Width = 28
.Height = 18
.Top = 86 + (i * 20)
.Left = 354 + (r * 30)
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
.Text = i & r
End With
Next r
i = i + 1 'Increment for array in case we find another order number
'Our second index "aGetData(index1,index2) is being resized
'this represents each order number found on the sheet
LineCount = LineCount + 1
'Set the scroll bar height for the final form.
ScrollBarHeight = 150 + (i * 20)
End If
Next c
Here is that code snippet:
'Loop through first column completely ( 0 - 5 to test)
' i = 0 means go through every box in column 0 first
For i = 0 To 5
'Loop through rows.
For r = 0 To 2 '( 0 - 2 rows to test)
ActiveCell.Offset(i, 0).value = PickTicketForm.Controls("PalletNumber" & i & r).Text
Next r
Next i
Here is the userform layout:
The spreadsheet output should look like this:
You should add your controls within a For i = 0 To 5 loop as well.
If it remains empty you are adding PalletNumber0, PalletNumber1, PalletNumber2 etc. while you are searching for PalletNumber00, PalletNumber01, PalletNumber02 etc.
Read all the rows for one column & display on textbox(s) which are created at run time.I am turning over to seek you assistance for below after several attempts which didn't help.
Name
ABC
AB
ABCEF
GHFD
I want all the rows from excel sheet to be shown in textbox just as they appear in sheet for a particular column.I am creating 4 textbox(s) that represent columns & 11 textbox(s) that represent rows. For the first column, I want the data to be displayed as it is in sheet. I am successful in creating text box as per my requirement but not able to display data as per needs. Thanks a ton for help
Public Sub UserForm_Initialize()
Set sh = ThisWorkbook.Sheets("Testing")
sh.Range("F21").Activate
With sh
fatalcount = WorksheetFunction.CountIf(Range("F:F"), "Fatal")
Majorcount = WorksheetFunction.CountIf(Range("F:F"), "Major")
Minorcount = WorksheetFunction.CountIf(Range("F:F"), "Minor")
End With
For jrow = 1 To 11
For i = 0 To 4
Set txtB1 = WtmsFrm.Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "chkDemo" & i
.Height = 20
.Width = 5 + 50 + 5
.Left = 10 + 50 * i + 2
.Top = 15 * jrow + 10
.ControlTipText = "Type of Bug"
End With
Next i
Next jrow
For Each tbox In Frm.Controls
' For counter = 2 To 11
If tbox.Name = "chkDemo" Then
tbox.Value = Sheets("sheet1").Cells(counter, 2).Value ' failing code
tbox.ControlTipText = "Name"
ElseIf tbox.Name = "chkDemo1" Then
tbox.Value = 1
ElseIf tbox.Name = "chkDemo2" Then
tbox.Value = 2
ElseIf tbox.Name = "chkDemo3" Then
tbox.Value = 3
ElseIf tbox.Name = "chkDemo4" Then
tbox.Value = 4
End If
' Next counter
Next
' Initialise the followings
Frm.txtFatal.Value = fatalcount
Frm.txtMajor.Value = Majorcount
Frm.txtMinor.Value = Minorcount
Frm.txtTotoal.Value = fatalcount + Majorcount + Minorcount
End Sub
I don't see you create a textbox named "chkDemo". They all have a number appended. As you take tbox from all controls, there might be a control on your sheet somewhere named "chkDemo" but which is not a textbox. Neither do I see counter declared or initialized. That might also let the code fail.
Note also that with .Name = "chkDemo" & i you give the same name to textboxes because you are also in a For jrow loop.
I have an interactive table filled with over 100 different command buttons, each of which assign values to variables then use a custom function to calculate their output. They reference a table on the second sheet to get the values they assign. Is there a way to, based on whether a cell contains content or not, change the color of each button? So far, here's what I have (non-functional, of course).
Sub Auto_Open()
Dim n As Integer
n = 2
Do Until n = 114
If Sheet2.Cells(n, 4) = vbNullString Or Sheet2.Cells(n, 5) = vbNullString Or Sheet2.Cells(n, 8) = vbNullString Or Sheet2.Cells(n, 9) = vbNullString Or Sheet2.Cells(n, 10) = vbNullString Or Sheet2.Cells(n, 11) = vbNullString Then
ActiveSheet.Shapes.Range(Array("CommandButton" & (n - 1))).Select
Range.Array(Selection).BackColor = 500
Else
ActiveSheet.Shapes.Range(Array("CommandButton" & (n - 1))).Select
Range.Array(Selection).BackColor = 300
End If
n = n + 1
Loop
End Sub
EDIT:
I can't explicitly state the color for each command button without having to write in over 100 different cases. I have 112 different command buttons; I'd have to write 112 seperate IF statements.
Example for one command button:
Dim cb As CommandButton
Set cb = Sheet1.CommandButton1
With Sheet2.Range("A1")
If .Value = "Red" Then
cb.BackColor = RGB(255, 0, 0)
ElseIf .Value = "Green" Then
cb.BackColor = RGB(0, 255, 0)
Else
cb.BackColor = RGB(155, 155, 155) ' gray
End If
End With
If you want to loop through many command buttons, you can do as follows. In this example, I look at cells A1:A5 on Sheet2, and set the colors of Sheet1's commandbuttons 1 through 5 accordingly.
Dim cb As CommandButton
Dim i As Long
For i = 1 To 5
Set cb = Sheet1.Shapes("CommandButton" & i).OLEFormat.Object.Object ' Ouch!
With Sheet2.Range("A1").Cells(i, 1)
If .Value = "Red" Then
cb.BackColor = RGB(255, 0, 0)
ElseIf .Value = "Green" Then
cb.BackColor = RGB(0, 255, 0)
Else
cb.BackColor = RGB(155, 155, 155) ' gray
End If
End With
Next i
The .Object.Object trick I got from here.