In fisierul atasat este scrisa o macrocomanda care deseneaza dreptunghiuri in functie de coordonatele X si Y din tabel.
1.Cum se rescrie macrocomanda folosind o instructiune for...next, ca sa treaca de la o inregistrare la alta, fara a fi nevoit sa scriu cod pentru fiecare rand (in realitate tabelul are zeci de inregistrari)?
2.Macrocomanda sa coloreze diferit dreptunghiul in functie de atributul din ultima coloana (pentru A o culoare, pentru B alta culoare).
Multumesc anticipat.
Cod: Selectaţi tot
Sub TRASEAZA()
'
Sheets("grafic").Select
Cells.Select
Range("D1").Activate
Selection.EntireRow.Hidden = False
ActiveSheet.DrawingObjects.Select
Selection.Delete
Range("C3").Select
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Range("C3").Value, Range("D3").Value, 90, 30).Select
Application.CutCopyMode = False
Selection.Formula = "=$B$3"
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
Selection.ShapeRange.TextFrame2.MarginLeft = 0
Selection.ShapeRange.TextFrame2.MarginRight = 0
Selection.ShapeRange.TextFrame2.MarginTop = 0
Selection.ShapeRange.TextFrame2.MarginBottom = 0
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 240, 20)
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Range("C4").Value, Range("D4").Value, 90, 30).Select
Application.CutCopyMode = False
Selection.Formula = "=$B$4"
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
Selection.ShapeRange.TextFrame2.MarginLeft = 0
Selection.ShapeRange.TextFrame2.MarginRight = 0
Selection.ShapeRange.TextFrame2.MarginTop = 0
Selection.ShapeRange.TextFrame2.MarginBottom = 0
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 240, 20)
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Range("C5").Value, Range("D5").Value, 90, 30).Select
Application.CutCopyMode = False
Selection.Formula = "=$B$5"
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
Selection.ShapeRange.TextFrame2.MarginLeft = 0
Selection.ShapeRange.TextFrame2.MarginRight = 0
Selection.ShapeRange.TextFrame2.MarginTop = 0
Selection.ShapeRange.TextFrame2.MarginBottom = 0
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 240, 20)
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Range("C6").Value, Range("D6").Value, 90, 30).Select
Application.CutCopyMode = False
Selection.Formula = "=$B$6"
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
Selection.ShapeRange.TextFrame2.MarginLeft = 0
Selection.ShapeRange.TextFrame2.MarginRight = 0
Selection.ShapeRange.TextFrame2.MarginTop = 0
Selection.ShapeRange.TextFrame2.MarginBottom = 0
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 240, 20)
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Range("C7").Value, Range("D7").Value, 90, 30).Select
Application.CutCopyMode = False
Selection.Formula = "=$B$7"
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
Selection.ShapeRange.TextFrame2.MarginLeft = 0
Selection.ShapeRange.TextFrame2.MarginRight = 0
Selection.ShapeRange.TextFrame2.MarginTop = 0
Selection.ShapeRange.TextFrame2.MarginBottom = 0
Selection.ShapeRange.Line.Weight = 2
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 240, 20)
Range("B2").Select
MsgBox ("Gata!")
End Sub