Draw Shape Based on Cell Values - excel

All,
I have code that creates a shape based on based on inputted values in the macro itself. I am wanting to have the values of shape type, width, and height specified by the user (location of shape on the sheet is indifferent to me right now). The user would input the aforementioned numerical values for width and height into the cells and click a button which would output the shape type and size the user wants.
In my case, there will be a drop down box for "rectangle" and "circle". I don't know how to get the code to read those words and convert it '1' and '9', respectively. I may just have the user choose 1 or 9 to create the shape.
I would also like to add text to the center of the shape. Again, I have created a code for this but it is within the macro. I would like to have the code reference a cell value instead. I assume it would be the same as above.
Thank you for any assistance.
Sub AddShape()
Dim s As Shape
Dim ws As Worksheet
Set ws = Sheets("Deck Layout")
'add a shape
Set s = ws.Shapes.AddShape(1, 80, 80, 75, 75)
'make it nearly white
s.Fill.ForeColor.RGB = RGB(245, 245, 255)
'show text within it
s.TextFrame.Characters.Text = "1"
s.TextFrame.Characters.Font.ColorIndex = 2
With s.TextFrame.Characters(0, 0)
s.TextFrame.HorizontalAlignment = xlHAlignCenter
s.TextFrame.VerticalAlignment = xlVAlignCenter
.Font.Color = RGB(0, 0, 0)
End With
End Sub

Since you've already got parts of the answer in the comments, I'll focus on the shape picking.
Have a look at this:
Dim ShapeType As MsoAutoShapeType
Select Case LCase(ws.Range("b1").Value)
Case "rectangle"
ShapeType = msoShapeRectangle
Case "circle"
ShapeType = msoShapeOval
End Select
Set s = ws.Shapes.AddShape(ShapeType, 80, 80, 75, 75)
It will find the value in B1, convert it to lower case and the test it for "rectangle" and "circle" and the set the ShapeType to a corresponding value.
You can use 1 and 9 instead, but that is bad practice. Use the defined constants - it will make your code much easier to read.

Related

Auto Resize a CommandButton based on string length

I have several commands buttons with text whose captions change based on various inputs. Also want to mention that these are command buttons on the worksheet itself, not on a form.
Is there a way to Auto Resize so that the button width accommodates the length of the text?
Here's a snippet of the pertinent code:
Sub FixButtonWidth()
'Create Button
Set rbtn = ActiveSheet.Buttons.Add(0, 0, 30, 20)
'User enters a string of some length
ShowThis = InputBox("What do you want to call your button?", "Button Name", "")
'Button Caption changes to whatever the user input
rbtn.Caption = ShowThis
'This next line is the problem:
'The width needs to be based on the width of the string
'Len(ShowThis) only gives the number of characters in the string . . .
'Since letters like 'Z' are much wider than letters ...
'like i (for example), Len(ShowThis) is not a good solution.
rbtn.Width = 500
End Sub
Like I said use rbtn.AutoSize = True after the set rbtn... part. And remove rbtn.width = 600
Sub FixButtonWidth()
'Create Button
Set rbtn = ActiveSheet.Buttons.Add(0, 0, 30, 20)
'User enters a string of some length
ShowThis = InputBox("What do you want to call your button?", "Button Name", "")
rbtn.AutoSize = True
'Button Caption changes to whatever the user input
rbtn.Caption = ShowThis
'This next line is the problem:
'The width needs to be based on the width of the string
'Len(ShowThis) only gives the number of characters in the string . . .
'Since letters like 'Z' are much wider than letters like i, for example Len(ShowThis) is not the solution
'rbtn.Width = 500
End Sub

Is it possible to address a shape with VBA code?

I am replacing all my ActiveX controls with Excel shapes, because of this well know problem. Therefore I replaced each ActiveX Button with a rectangular shape assigning a macro to each shape:
My question is if I can address those 'shape buttons' with my vba code. Something simple like change the backgroung color of the "Review Start" button should be possible, right?
I'm thinking of something like:
Activesheet.shapes("Review Start").background.colorindex = 1
(This code is obviously not working)
One way is this. Assign a variable to the shape and then you can access its properties and methods easily. I'm not sure there's a way without using RGB.
By declaring the variable as Shape type, Intellisense will show you the properties and methods. Also you can use the Object Browser (F2).
Sub x()
Dim s As Shape
Set s = ActiveSheet.Shapes("Review Start") 'better to specify a sheet name
With s
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.TextFrame.Characters.Font.Color = vbBlack
.TextFrame.Characters.Text = "Fred"
End With
End Sub

Add multiple signature blocks into excel document using vba

I'm using vba to create an excel document and fill it in dynamically (already completed and working perfectly). What I need is: to figure out how to add, size, position, and prefill (suggested signer, email, but not the signature itself) the signature block at multiple locations in this document.
I don't even know if this can be done with vba (my searches on the subject have been unhelpful), but I'm hopeful as it will save me a lot of time and tedious work in the future. Any help on this would be welcome.
You may want to place simple text boxes across defined cells (as anchor points) and fill it with some text. To get you started here's the bare minimum that you need:
the actual text box creating Sub which takes all info as parameters:
Sub CreateShapeText(NailToCell As Range, w_pt As Single, h_pt As Single, DTxt As String)
Dim TB As Shape
' create a text box shape
' note: shapes belong to worksheets, therefore we derive a WS from cell.parent
Set TB = NailToCell.Parent.Shapes.AddLabel(msoTextOrientationHorizontal, NailToCell.Left, NailToCell.Top, w_pt, h_pt)
' make its border visible
TB.Line.Visible = msoTrue
' switch off that annoying auto-resize when text is entered
TB.TextFrame2.AutoSize = msoAutoSizeNone
' enter text ... and yes - this object tree is crazy
TB.TextFrame2.TextRange.Characters.Text = DTxt
' as it should be - text is vertical bottom
' but to have more control over the TB, this could be a parameter, too
TB.TextFrame2.VerticalAnchor = msoAnchorBottom
End Sub
and you would call that from wherever in your code as in below example
Sub CallCreate()
CreateShapeText [A1], 132, 32, "sign: me"
CreateShapeText [C12], 132, 32, "sign: you"
End Sub
You take it from here and research what these objects can do for you (e.g. make dotted lines instead of solid for the frame, experiment with font sizes, alignments etc.) and come back with more questions in case ...

How To: Hover Over Shape Shows TextBox

I am trying to make it so when a user hovers over a triangle as shown below, a textbox pops up with certain information pertaining to that triangle.
Triangles are drawn with the following function...
Public Sub drawTriangle(theRow As Integer, theColumn As Integer, Optional myColor As System.Drawing.Color = Nothing)
myColor = System.Drawing.Color.Black
Dim theShape As Microsoft.Office.Interop.Excel.Shape = xlWorkSheet.Shapes.AddShape(MsoAutoShapeType.msoShapeIsoscelesTriangle, (xlWorkSheet.Cells(theRow, theColumn)).Left + 18, (xlWorkSheet.Cells(theRow, theColumn)).Top, 15, 14)
theShape.Fill.ForeColor.RGB = ToBgr(myColor)
theShape.Line.ForeColor.RGB = ToBgr(myColor)
End Sub
I haven't been able to find any examples or good documentation about how I would do this, so I thought I'd ask here. Any and all help is much appreciated!!
According to MSDN, comments can be added to ranges. For this to work for your application, you simply need to select the range that corresponds to your shape, and then call AddComment().
The numeric coordinates of a cell can be used to determine the actual Cell name (i.e. E5) by using code like the following(source):
address = xlWorkSheet.Cells(RowVariable, ColVariable).Address
This can be followed up with:
xlWorkSheet.Range(address).AddComment("This is a comment")

Changing bar colors in bar graph

I've created a VBA for Excel 2007 program that automatically creates bar graphs for ROI based on up to 52 different tabs in the active workbook. I'm close to done, and the only thing I cannot figure out is how to change the colors of the bargraphs.
The graphs are created in their own subfunction, called with a call like so. Every variable changes around whenever it's called.
Call AddChartObject(1, 1, "Example", extraWeeks, weekDifference)
My sub that it calls looks like this.
Sub AddChartObject(j As Integer, k As Integer, passedChartTitle As String, xtraWks As Integer, ttlWks As Integer)
Dim topOfChart As Integer
topOfChart = 25 + (350 * j)
'Adds bar chart for total sales
With ActiveSheet.ChartObjects.Add(Left:=375, Width:=475, Top:=topOfChart, Height:=325)
.Chart.SetSourceData Source:=Sheets("Consolidation").Range("$A$" & 3 + ((17 + xtraWks) _
* j) & ":$C$" & (4 + ttlWks) + ((17 + xtraWks) * k))
.Chart.ChartType = xl3DColumnClustered
.Chart.SetElement (msoElementDataLabelShow)
.Chart.HasTitle = True
.Chart.ChartTitle.Text = passedChartTitle & " Sales"
.Chart.SetElement (msoElementLegendBottom)
.Chart.SetElement (msoElementDataLabelNone)
.Chart.RightAngleAxes = True
End With
End Sub
The RGB color I want to use on the SECOND series in the bar chart is (155, 187, 89), per marketing's wishes. I'm pretty sure there is a .chart.????.???? = RGB (155, 187, 89) command I can use in my With to set this, but I have spent far too much time trying to figure it out, only to come up with nothing.
Have you tried
.Chart.SeriesCollection([index]).Interior.Color = RGB(155, 187, 89)
(where [index] is a placeholder for the series you want to change the color for)?
It works for me ScottyStyles in a very similar situation, but only for the first series collection. I used the same right below that, and that was not changing the color of the SeriesCollection(2). That one is a linear set of datas.
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ClearToMatchStyle
ActiveChart.SeriesCollection(1).Interior.Color = RGB(85, 142, 213)
ActiveChart.SeriesCollection(2).Interior.Color = RGB(192, 0, 0)
to change different bars inside a collection you can use:
ActiveChart.SeriesCollection(1).Points(1).Format.Fill.ForeColor.RGB = RGB(85, 142, 213)
ActiveChart.SeriesCollection(1).Points(2).Format.Fill.ForeColor.RGB = RGB(192,0, 0)
...

Resources