Adding an Autoshape to a selected cell with Userform Currently i have Userform w

Question

Adding an Autoshape to a selected cell with Userform

Currently i have Userform with a Combobox which gives me options to insert into a selected cell on the spreadsheet. I am trying to attach a few lines of code to add an Autoshape as well as a letter, but I am having trouble. I am trying to add a Right Arrow when "Joining" is selected and Ok pressed.

Private Sub Ok_Click()
Select Case Activity.Text
          Case Is = "TX"
      Selection.Value = "TX" ' put TX into selected cells
      Selection.Interior.Color = 6684927
      Selection.Font.Color = 6684927
      Case Is = "Resettlement"
      Selection.Value = "R" ' put R into selected cells
      Selection.Interior.Color = 5287936
      Selection.Font.Color = 5287936
      Case Is = "Joining"
      Selection.Value = "J" ' put J into selected cells              <---------- To be added to this section
      Selection.Font.ColorIndex = 2
      Selection.Interior.ColorIndex = x1None
      Case Else
      'ignore empty or other entry
      MsgBox "Please enter an Activity or Cancel.", vbExclamation, "Insert an Activity"
      Me.Activity.SetFocus
     Exit Sub ''' to avoid going further and hide the form
End Select
Me.Hide
End Sub

Thanks

Explanation / Answer

To add multiple arrows:

Case Is = "Joining"

For Each R in Selection.Cells

R.Value = "J" ' put J into selected cells
R.Font.ColorIndex = 2
R.Interior.ColorIndex = x1None
ActiveSheet.Shapes.AddShape(msoShapeRightArrow, R.Left, R.Top, R.Width, R.Height).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 112, 192)
.Transparency = 0
.Solid
End With

Next R

To clear the shapes from a selected range of cells

Sub ClearSelectionFill()
Dim sh As Shape
  
Selection.Interior.Color = xlNone
Selection.ClearContents

For Each sh In ActiveSheet.Shapes
If Not Intersect(Selection, sh.TopLeftCell) Is Nothing Then
sh.Delete
End If
Next sh
  
End Sub

Related Questions

Navigate

• Browse (All)
• Browse A
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.