VBA for creating shapes

[Jacq78]

Hi, I am working on an existing vba script - the shapes are currently uniform & the existing script is as follows:

Select Case sRAG

Case "R", "Red"
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset38
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.Weight = 0.5
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, BaseLeft - gShapeSize * 2, nTop - 2, 0#, 0#).Select
Selection.ShapeRange(1).TextFrame.AutoSize = msoTrue
Selection.Font.Name = "Arial"
Selection.Font.Size = DescFont
Selection.Font.ColorIndex = xlAutomatic
Selection.Characters.Text = Format(sMilestoneBFinish, "DD/MM")

I want to size the shapes depending on the weight of the issue as per a column in the workbook small would remain the current size, medium would be larger & large would be larger again - what changes do I need to make to the existing script?

Many thanks

 

[John_w]

Set the shape's Width and Height properties to specific values for small, medium or large. Or call the shape's ScaleWidth and ScaleHeight methods and change the size based on a percentage of the small width and height. This code shows both approaches - put it below your code.

    Dim weight As String
    Dim smallWidth As Single, smallHeight As Single
    
    smallWidth = 100
    smallHeight = 60
    weight = "small"
    'weight = "medium"
    'weight = "large"
    
    With Selection.ShapeRange
        Select Case weight
            Case "small"
                .Width = smallWidth
                .Height = smallHeight
            Case "medium"
                .ScaleWidth smallWidth / 100 * 1.2, msoFalse, msoScaleFromTopLeft   '120% of small
                .ScaleHeight smallHeight / 100 * 1.2, msoFalse, msoScaleFromTopLeft
            Case "large"
                .ScaleWidth smallWidth / 100 * 1.4, msoFalse, msoScaleFromTopLeft   '140% of small
                .ScaleHeight smallHeight / 100 * 1.4, msoFalse, msoScaleFromTopLeft
        End Select
    End With

 

[Jacq78]

Thank you for your reply, it's greatly appreciated. I am new to vba with very limited experience - how do I link the vba to read a column that will determine if the size should be small, medium or large?

 

[John_w]

Without knowing exactly how your sheet is laid out (e.g. which column is 'weight') and how you want to read the column (e.g. a single cell or loop through multiple rows in the column) to affect the size of the shapes I can't provide specific code.

Generally, you read a cell's value by specifying a sheet (name or index) and cell address (row and column) with the Cells or Range .Value property. Cells specifies a single cell, whereas Range specifies either a single cell or multiple cells. In these examples, the weight is read from A2 on the active sheet (using both Range and Cells), and then every cell in column A starting at A2 and ending at the last populated cell in column A.

    With ActiveSheet
        weight = .Range("A2").Value
        weight = .Cells(2, "A").Value
    End With

    Dim cell As Range
    With ActiveSheet
        For Each cell In .Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
            weight = cell.Value
            MsgBox cell.Address & " " & weight
        Next
    End With