（未解决）如何根据次数，动态地画出长方形。求帮助 - 第3页 - 宏和VBA小程序开发 - office办公网

kww001 发表于 2019-10-11 13:54:04

基本就是这个样子，有不明白的地方，还要向您请教。:P

laoxiaozi 发表于 2019-10-11 13:54:43

weiyingde，大神，还有几个问题：

1.          With .Shapes("Label1")'显示当前摸到的是哪张牌
            ' .Fill.BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
            ' .Fill.ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
            With .OLEFormat.Object
                  .Caption = sr
                  .ForeColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  .BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  With .Font
                        .Name = "Arial Black"
                        .Bold = True
                        .Size = 40
                  End With
            End With
      End With
这个标签，在点击开始按钮之前隐藏，点击开始按钮之后出现，且背景为透明、无边框线；

2.       With Shapes("矩形 13") '根据摸到的次数画出条形图
            .Height = i * 400 / 500
            .Top = 419.62 - i * 384 / 500
            With .Fill
                  .ForeColor.RGB = RGB(128, 0, 0) 'RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  .BackColor.RGB = RGB(170, 170, 170) 'RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
            End With
      End With
这个长方形，在点击开始按钮之前也隐藏，点击开始按钮之后出现，且在变高的过程中，不能有向下的位移，不然会到了X轴下方

3.       tm1 = Timer'控制刷新的时间
      Do
         DoEvents
      Loop While Timer - tm1 < 0.0004
上面这一段，应该是控制时间的，已经改成了0.0004，感觉还是慢，希望时间再快一些，怎么办？（可不可改成摸10次牌，刷新一次）

hongwu143 发表于 2019-10-11 13:57:16

1、用label控件作显示，存在一个刷新的延迟的问题，若事先隐藏再显示的话，则可能出现要先的字符不能变化的问题。
2、可以是实现，向下延伸的问题，可能是感觉的问题。
3、0.0004秒应该是很快的速度，若向再快，建议换成用自选图形实现；若再不行，要更换别的编程语言来实现。那么在下也无能为力了。
Private Sub CommandButton1_Click()
On Error Resume Next
With ActivePresentation.Slides(1)
For i = 1 To 500
   Randomize
         rd = Int(Rnd * 4) + 1
         sr = Choose(rd, "A", "B", "C", "D")
         If rd = 1 Then a = a + 1
         If rd = 2 Then b = b + 1
         If rd = 3 Then c = c + 1
         If rd = 4 Then d = d + 1

         With .Shapes("Label1")
            .Visible = msoCTrue
            With .OLEFormat.Object
                  .Caption = sr
                  .ForeColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  .BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  With .Font
                        .Name = "Arial Black"
                        .Bold = True
                        .Size = 40
                  End With
            End With

      End With
      With .Shapes("Rectangle 20")
            .Visible = msoTrue
            .Height = i * 400 / 500
            .Top = 419.62 - i * 384 / 500
            With .Fill
                  .ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) 'RGB(128, 0, 0)
                  .BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) 'RGB(170, 170, 170)
            End With
      End With
      With Shapes("文本框 21")
            With .TextFrame.TextRange
                  .Text = "共摸了" & i & "次"
                  With .Font
                     .NameFarEast = "楷体"
                     .Bold = True
                     .Size = 28
                     .Color.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  End With
            End With
      End With

      For j = 1 To 4
            With .Shapes("Label" & 1 + j)
               .Width = Choose(j, a, b, c, d) * 4
               .Fill.BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               .Fill.ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               With .OLEFormat.Object
                     .Caption = Choose(j, a, b, c, d) & "次"
                     .ForeColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                     .BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                     With .Font
                           .Name = "楷体"
                           .Bold = True
                           .Size = 18
                     End With
               End With
            End With
      Next
   tm1 = Timer
      Do
         DoEvents
   Loop While Timer - tm1 < 1
Next
.Shapes("Label1").Visible = msoFalse
.Shapes("Rectangle 20").Visible = msoFalse
End With
End Sub

dxwmutu 发表于 2019-10-11 14:03:50

已经很好了，非常感谢。

john1998 发表于 2019-10-11 14:30:03

非常感谢！
1.if 摸的次数i是10的倍数 then
上面的条件语句怎么写？
2. For i = 1 To 50
把步长改成2，即每次增加2，语句怎么写？

求大神帮帮忙啊

angel2004 发表于 2019-10-11 14:32:39

Private Sub CommandButton1_Click()
On Error Resume Next
With ActivePresentation.Slides(1)
' For i = 1 To 500
'2、改为步长为2，代码如下：
For i = 1 To 500 Step 2
   Randomize
         rd = Int(Rnd * 4) + 1
         sr = Choose(rd, "A", "B", "C", "D")
         If rd = 1 Then a = a + 1
         If rd = 2 Then b = b + 1
         If rd = 3 Then c = c + 1
         If rd = 4 Then d = d + 1
         '1、第一个问题：提示摸了10的倍数。
         N = N + 1
         If N Mod 10 = 0 Then
            m = m + 1
            iStr = "次数：10的" & m & "倍。"
         Else
            iStr = "共摸了" & N & "次"
         End If
      ' If N Mod 10 = 0 Then MsgBox Space(10) + "已经摸了" + N + "次" & vbCrLf & "是10的" + N / 10 & "倍。", vbCritical, "温馨提示"
         With .Shapes("Label1")
            .Visible = msoCTrue
            With .OLEFormat.Object
                  .Caption = sr
                  .ForeColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  .BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  With .Font
                        .Name = "Arial Black"
                        .Bold = True
                        .Size = 40
                  End With
            End With

      End With
      With .Shapes("Rectangle 20")
            .Visible = msoTrue
            .Height = i * 400 / 500
            .Top = 419.62 - i * 384 / 500
            With .Fill
                  .ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) 'RGB(128, 0, 0)
                  .BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255)) 'RGB(170, 170, 170)
            End With
      End With
      With Shapes("文本框 21")
            With .TextFrame.TextRange
                  .Text = iStr
                  With .Font
                     .NameFarEast = "楷体"
                     .Bold = True
                     .Size = 28
                     .Color.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                  End With
            End With
      End With

      For j = 1 To 4
            With .Shapes("Label" & 1 + j)
               .Width = Choose(j, a, b, c, d) * 4
               .Fill.BackColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               .Fill.ForeColor.RGB = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
               With .OLEFormat.Object
                     .Caption = Choose(j, a, b, c, d) & "次"
                     .ForeColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                     .BackColor = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
                     With .Font
                           .Name = "楷体"
                           .Bold = True
                           .Size = 18
                     End With
               End With
            End With
      Next
   tm1 = Timer
      Do
         DoEvents
   Loop While Timer - tm1 < 1
Next
.Shapes("Label1").Visible = msoFalse
.Shapes("Rectangle 20").Visible = msoFalse
End With
End Sub

smilingdov 发表于 2019-10-11 14:32:48

附件如下，请参阅。

疯雪飘凌 发表于 2019-10-11 14:55:44

非常感谢。通过这个例子学会了很多，知道了怎么通过语言控制页面中的元素，显示内容不一定非得用标签控件，还有一些常用的语法……，非常感谢！！！

zhou_yb 发表于 2019-10-11 14:56:32

不谢不谢，共同学习，一起进步。

raijin002 发表于 2019-10-11 14:57:33

求教：

1.On Error Resume Next
With ActivePresentation.Slides(1)
这两行代码什么意思？第二行，怎么改成用current表示的句子。

2.    tm1 = Timer'控制时间
      Do
         DoEvents
   Loop While Timer - tm1 < 0.01
上面这几行分别是什么意思？

页: 1 2 [3] 4

office办公网's Archiver