如何使用VBA Loop对齐形状

时间:2019-07-11 20:44:09

标签: excel vba

我的代码循环一个单元格范围,如果该范围内的单元格值大于1,则返回一个带有单元格值的形状。

我希望将每个新添加的形状均匀地放置在第一个添加的形状的右侧。

目前,我的代码将每个形状堆叠在一起。

代码

currentStatus = ''; // set by some other function
previousStatus ='';
displayedOn = 0;
color ='black';
// MY ADDITION - flag whether we're on a red-until-ok status.
redUntilOk = false;

function displayStatus() {
  const date = new Date();
  const now = date.getTime();

  switch (currentStatus) {
    case "ok":
      // MY ADDITION - reset the red-until-ok flag, if it's been set
      redUntilOk = false;
      color ='black';

      if (this.previousSyncState == 'careful' || this.previousSyncState =='danger'){
        // previous status was an error of one kind so update
        // the last sync error reported then reset the timestamp
        localStorage.setItem('lastDate', date);
        displayedOn = now;
      }

      break;
    case "careful":
    case "danger":

      // has it been 30 minutes?

      var difference = now - displayedOn;
      var resultInMinutes = Math.round(difference / 60000);


      const minutesToWaitBeforeColorChange = 30;
      if (
        resultInMinutes >= minutesToWaitBeforeColorChange &&
        ["danger", "careful"].indexOf(previousStatus) > -1
      ) {
        // previously it was error and continueing to be same.
        displayedOn = now;
        this.isLateWarning = "red";
      } 
      // MY ADDITION - don't reset to blue if the flag is on
      else if (!redUntilOk) {
        // it is either not 30 minutes on continue of an error
        // or previous it was ok
        this.isLateWarning = "blue";

        // MY ADDITION - set red in two minutes.
        setTimeout(() => { 
          this.isLateWarning = "red"; 
          redUntilOk = true;
        }, 2 * 60 * 1000);
      }

      break;
    default:
      // MY ADDITION - don't reset to black if the flag is on
      if (!redUntilOk) {
        this.isLateWarning = "black";
      }
  }
}

屏幕截图 enter image description here

1 个答案:

答案 0 :(得分:5)

一些数学应该可以解决问题。 9575的宽度加上20的边距。根据需要进行调整。

For Each rCell In rng
    If IsNumeric(rCell.Value) Then
        If rCell.Value > 0 Then
            Dim counter As Long
            counter = counter + 1

            Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 95 * (counter - 1), w + 1, 75, 80)

            With oval
                .Line.Visible = True
                .Line.Weight = 8
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .TextFrame.Characters.Caption = rCell.Value
                .TextFrame.HorizontalAlignment = xlHAlignCenter
                .TextFrame.VerticalAlignment = xlVAlignCenter
                .TextFrame.Characters.Font.Size = 22
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            End With
        End If
    End If
Next rCell

请注意,Shapes.AddShape的参数为 Type Top Width ,< em> Height ,因此对于{em> Left 和 Top 使用hw有点困惑。