VBA-shape with realtive positioning - vba

Question

I have this code but it's not working as I want it.
This is what I want:
-if I write something in cell A1,A2 or A3 (in worksheet1) a textbox is created in worksheet(2). This works but now I want the place of the textbox to change when I right in cell B1,B2,B3.
I tried to do that with the code below, but I think there might be a problem with the way I defined the Range("B" & CStr(i)) because when I use just B1 it works.
I need to change the code two do two things differently:
1- If I write in B1 "cliente" I want the texbox with the text from A1 to be created in toppos=150 and if I change it to "financeiro" I want the texbox to be created in toppos=20.
2- If B1 and B2 have "fianceiro" written I want the textboxes related to A1 and A2 to be next to each other.
Can someone help me?
Thank you
So this is what I want:
-Textboxes created with the content of cells A1 to A3 on worksheet 2;
-If I change the content the content of the textbox should be updated, if I erase the value then the textbox should be deleted;
-the position of the textboxes should change with the options I choose in column B. I want the worksheet(2) to have 4 "slices", the first is for the option "financeiro", so all the textboxes related to that slice of page should be in a specific place in the worksheet, for example, in position 20, if on the other hand that textbox is from the option "cliente", the textbox should be in the slice related to "cliente", position 150.
-also each option in column B might have more then one textbox so I want the textboxes from the same option to appear side by side.
Sub removercaixas(strName As String)
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox And shp.Name = strName Then shp.Delete
Next shp
End Sub
Sub criarcaixastexto(strName As String)
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Dim leftpos As Long
Dim toppos As Long
Dim i As Long
For i = 1 To 3
If Worksheets(1).Range("B" & CStr(i)).Value = "financeiro" Then
toppos = 20
ElseIf Worksheets(1).Range("B" & CStr(i)).Value = "cliente" Then
toppos = 150
ElseIf Worksheets(1).Range("B" & CStr(i)).Value = "processos internos" Then
toppos = 250
Else:
toppos = 350
End If
Next i
Select Case strName
Case Is = "$A$1"
leftpos = 50
Case Is = "$A$2"
leftpos = 200
Case Is = "$A$3"
leftpos = 350
End Select
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, leftpos, toppos, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
box.Name = strName
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case Target.Address
Case "$A$1", "$A$2", "$A$3"
removercaixas (Target.Address)
If Len(Target) > 0 Then criarcaixastexto (Target.Address)
Case Else
Exit Sub
End Select
End Sub

Answer 1

I'm not sure of some of the OP's logic or exactly what he wants to accomplish. Instead of adding and removing textboxes, I would create a Function that would create the textbox, if needed, and return a reference to it.
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Or Not Sh.Index = 1 Or Len(Target) = 0 Then Exit Sub
Dim box As Shape
If Not Intersect(Target, Range("B1:B3")) Is Nothing Then
Set box = getCaixas(Worksheets(2), Target.Offset(0, -1).Address)
Select Case Target.Value
Case Is = "financeiro"
box.Top = 20
Case Is = "cliente"
box.Top = 150
Case Is = "processos internos"
box.Top = 250
End Select
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim box As Shape
If Target.Count > 1 Or Not Sh.Index = 1 Or Len(Target) = 0 Then Exit Sub
If Not Intersect(Target, Range("A1:A3")) Is Nothing Then
Set box = getCaixas(Worksheets(2), Target.Address)
Select Case Target.Address
Case Is = "$A$1"
box.Left = 50
Case Is = "$A$2"
box.Left = 200
Case Is = "$A$3"
box.Left = 350
End Select
box.TextFrame.Characters.Text = Target.Value
End If
End Sub
Function getCaixas(ws As Worksheet, CaixasName As String) As Shape
Dim box As Shape
On Error Resume Next
Set box = ws.Shapes(CaixasName)
If Err.Number <> 0 Then
Set box = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 50)
box.Name = CaixasName
End If
On Error GoTo 0
Set getCaixas = box
End Function