Блог

Я создал скрипт на VBA, так что на каждой итерации моя фигура опускается на одну строку до каждого листа, в то время как фигура ниже поднимается, создавая заметный эффект на листе, на котором находится пользователь. Я оставляю ниже пример того, как это будет:

При выполнении мои фигуры выравниваются одна поверх другой, и в цикле 2 все работает правильно

   Sub MenuFormatter ()
    
        Dim start As Range
        Dim posCurrent As Range
        Dim posEnd As Range
        
        Dim coorEnd_X As Double
        Dim coorEnd_Y As Double
        
        Dim styleFocus As Shape
        Dim styleStatic As Shape
        
        Dim fontFocus As Shape
        Dim fontStatic As Shape

        
        ActiveSheet.Range ("O12"). Select
        
    For I = 2 To 23
     
        
        ActiveWorkbook.Worksheets (I) .Select
        

        Set posCurrent = Selection 'Initial Position as reference

        
        Set posEnd = posCurrent.Offset (2, 0) 'Position below, next item
       

        coorFinal_X = posFinal.Left 'Horizontal Coordinate
        coorFinal_Y = posFinal.Top 'Vertical Coordinate
        
        
        'Select the shape objects
        Set styleStatic = Worksheets (I) .Shapes ("static-" amp; I)
        Set estiloFocus = Worksheets (I) .Shapes ("focus")
        
        
        'Select the Font object
        Set fontFocus = Worksheets (I) .Shapes ("title-" amp; I - 1)
        Set fontStatic = Worksheets (I) .Shapes ("title-" amp; I)
        
        'Move Focus down
        styleFocus.Left = coorFinal_X
        styleFocus.Top = coorFinal_Y
        
        'Change the color from highlight to statico
        fontFocus.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB (98, 114, 164)
        
        'Move the Statico down
        styleStatic.Top = posCurrent.Top
        styleStatic.Left = posCurrent.Left
        
        'Change the color to the static (default) style for highlighting
        fontStatic.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB (248, 248, 242)
      
        'Reset the reference point
        posEnd.Select

     Next I

End Sub