I have several issues here.
What I need is two vba codes:
1. I need a macro to find a relative position to insert a shape to assign a macro (called addrow): The below code is not dynamic.
2. Another macro to copy the above macro into multiple workbooks saved under a folder. I just copied below code manually into a new workbook. But when I clicked the macro assigned shape, I had an error message. "Cannot run the macro 'addrow'. The macro may not be available'
Sub ADDLINEBELOW()
Worksheets("xxx").Activate
Dim i As Integer
Dim s As Range
Dim cl As Range
Do
i = i + 1
Loop Until Cells(i, "b").Value = "Totals:"
Cells(i, "b").Offset(0, -1).Select
Set s = Cells(i, "b").Offset(0, -1)
With Selection
For Each Ccl In s
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 149.1666929134, 692.5, _
101.6666141732, 30.8333070866).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Click to insert row "
End With
Next
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.OnAction = "addrow"
End With
End Sub
What I need is two vba codes:
1. I need a macro to find a relative position to insert a shape to assign a macro (called addrow): The below code is not dynamic.
2. Another macro to copy the above macro into multiple workbooks saved under a folder. I just copied below code manually into a new workbook. But when I clicked the macro assigned shape, I had an error message. "Cannot run the macro 'addrow'. The macro may not be available'
Sub ADDLINEBELOW()
Worksheets("xxx").Activate
Dim i As Integer
Dim s As Range
Dim cl As Range
Do
i = i + 1
Loop Until Cells(i, "b").Value = "Totals:"
Cells(i, "b").Offset(0, -1).Select
Set s = Cells(i, "b").Offset(0, -1)
With Selection
For Each Ccl In s
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 149.1666929134, 692.5, _
101.6666141732, 30.8333070866).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Click to insert row "
End With
Next
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.OnAction = "addrow"
End With
End Sub