（未解决）如何根据次数，动态地画出长方形。求帮助

rgzyj@163.com · 发表于 2019-10-28 21:21

weiyingde 发表于 2019-10-28 17:08
申明私有变量，好在过程结束后，能够存储数值。

麻烦帮我看一下，下面的代码是什么问题:
需实现：点击按钮后，循环2000次，记录下摸到A、B、C、D的次数，再显示出来。

Private n As Integer '申明私有变量，好在过程结束后，能够存储数值。
Private a As Integer '记录摸到A的次数
Private b As Integer '记录摸到B的次数
Private c As Integer '记录摸到C的次数
Private d As Integer '记录摸到D的次数
Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape
Dim i As Integer
Dim arr
arr = Array("A", "B", "C", "D")

For n = 1 To 2000
Randomize
rd = Int(Rnd * 4) '从上面的数组中随机选取
If rd = 0 Then a = a + 1
If rd = 1 Then a = b + 1
If rd = 2 Then a = c + 1
If rd = 3 Then a = d + 1
Next

With ActivePresentation.Slides(1)
   Set shps = .Shapes
   For Each shp In shps
      If shp.Type = 1 Then shp.Delete
   Next
   For i = 1 To 2
      lf = 190
      tp = Choose(i, 250, 300)
      wd = 450
      ht = 50
      nm = Choose(i, "字母", "数字")
      With shps.AddShape(1, lf, tp, wd, ht)
         .Fill.BackColor.RGB = vbGreen
         .Name = nm
         With .TextFrame.TextRange
               .Text = Choose(i, "A、B、C、D分别被摸到" & a & "次、" & b & "次、" & c & "次、" & d & "次", "你一共摸了：" & n & "次")
               With .Font
                     .NameOther = IIf(i = 1, "Arial Black", "楷体")
                     .NameAscii = IIf(i = 1, "Arial Black", "楷体")
                     .NameFarEast = IIf(i = 1, "Arial Black", "楷体")
                     .Bold = True
                     .Size = IIf(i = 1, 15, 35)
                     .Color.RGB = vbYellow
               End With
         End With
      End With
Next
End With
End Sub

rgzyj@163.com · 发表于 2019-10-29 13:00

weiyingde 发表于 2019-10-28 17:08
申明私有变量，好在过程结束后，能够存储数值。

麻烦帮我看看上楼的代码

rgzyj@163.com · 发表于 2019-10-29 13:38

本帖最后由 rgzyj@163.com 于 2019-10-29 14:11 编辑

Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape
Dim i As Integer
Dim arr
arr = Array("A", "B", "C", "D")

For n = 1 To 2000
Randomize
rd = Int(Rnd * 4) '从上面的数组中随机选取
Label1.Caption = arr(rd) '此行显示当前摸到的字母，前面的代码有误，求帮改
If rd = 0 Then a = a + 1
If rd = 1 Then b = b + 1
If rd = 2 Then c = c + 1
If rd = 3 Then d = d + 1
                        '此行显示，截止当前一其摸A到的次数，代码怎么写啊
                        '此行为一函数，自动停留一定的时间，代码怎么写啊
                        '此行为一停顿按钮，点击继续，代码怎么写啊

                        '此行画出长条，宽为20，长条的高为摸到A的次数，代码怎么写
                        '此行画出长条，宽为20，长条的高为摸到B的次数，代码怎么写


Next
End Sub

大侠以这个为准，帮忙上面空着的部分怎么写啊

weiyingde · 发表于 2019-10-29 13:42

本帖最后由 weiyingde 于 2019-10-29 13:51 编辑

rgzyj@163.com 发表于 2019-10-29 13:00
麻烦帮我看看上楼的代码

Private n As Integer '申明私有变量，好在过程结束后，能够存储数值。
Private a As Integer '记录摸到A的次数
Private b As Integer '记录摸到B的次数
Private c As Integer '记录摸到C的次数
Private d As Integer '记录摸到D的次数
Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape
Dim i As Integer
Dim arr
arr = Array("A", "B", "C", "D")

Randomize
rd = Int(Rnd * 4) '从上面的数组中随机选取
If rd = 0 Then a = a + 1
If rd = 1 Then b = b + 1
If rd = 2 Then c = c + 1
If rd = 3 Then d = d + 1
n = n + 1
With ActivePresentation.Slides(1)
   Set shps = .Shapes
   For Each shp In shps
      If shp.Type = 1 Then shp.Delete
   Next
   For i = 1 To 2
      lf = 190
      tp = Choose(i, 250, 300)
      wd = 450
      ht = 50
      nm = Choose(i, "字母", "数字")
      With shps.AddShape(1, lf, tp, wd, ht)
         .Fill.BackColor.RGB = vbGreen
         .Name = nm
         With .TextFrame.TextRange
               .Text = Choose(i, "A、B、C、D分别被摸到" & a & "次、" & b & "次、" & c & "次、" & d & "次", "你一共摸了：" & n & "次")
               With .Font
                     .NameOther = IIf(i = 1, "Arial Black", "楷体")
                     .NameAscii = IIf(i = 1, "Arial Black", "楷体")
                     .NameFarEast = IIf(i = 1, "Arial Black", "楷体")
                     .Bold = True
                     .Size = IIf(i = 1, 15, 35)
                     .Color.RGB = vbYellow
               End With
         End With
      End With
   Next
End With
End Sub

rgzyj@163.com · 发表于 2019-10-29 14:22

本帖最后由 rgzyj@163.com 于 2019-10-29 18:34 编辑

weiyingde 发表于 2019-10-28 14:25
已经帮你改好，随机选取得地方给你标识了。
可以的话，赏朵小花。
你测试，看是否满意。

Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape
Dim i As Integer
Dim arr
arr = Array("A", "B", "C", "D")

For n = 1 To 2000
Randomize
rd = Int(Rnd * 4) '从上面的数组中随机选取
Label1.Caption = arr(rd)   '此行显示当前摸到的字母，前面的代码有误，求帮改
If rd = 0 Then a = a + 1
If rd = 1 Then b = b + 1
If rd = 2 Then c = c + 1
If rd = 3 Then d = d + 1
                        '此行显示，截止当前一共摸A到的次数，代码怎么写啊
                        '此行为一函数，自动停留一定的时间，代码怎么写啊
                        '此行为一停顿按钮，点击继续，代码怎么写啊

                        '此行画出长条，宽为20，长条的高为摸到A的次数，代码怎么写
                        '此行画出长条，宽为20，长条的高为摸到B的次数，代码怎么写


Next
End Sub

大侠以这个为准，帮忙上面空着的部分怎么写啊，求帮助！求帮助！求帮助！

weiyingde · 发表于 2019-10-29 19:12

rgzyj@163.com 发表于 2019-10-29 14:22
Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape

不明白你要做什么。

rgzyj@163.com · 发表于 2019-10-29 20:07

具体文件如下：

Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape
Dim i As Integer
Dim arr
arr = Array("A", "B", "C", "D")

For n = 1 To 2000
Randomize
rd = Int(Rnd * 4) '从上面的数组中随机选取
Label1.Caption = arr(rd) '此行显示当前摸到的字母，前面的代码有误，求帮改
If rd = 0 Then a = a + 1
If rd = 1 Then b = b + 1
If rd = 2 Then c = c + 1
If rd = 3 Then d = d + 1
                        '此行显示，截止当前一共摸A到的次数
                        '此行画出长条，宽为20，长条的高为摸到A的次数，代码怎么写
                         '此行自动停留一定的时间


Next
End Sub

weiyingde · 发表于 2019-10-29 23:35

夜深了，还是给你做好了。
Private a
Private b
Private c
Private d
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")
               .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
         With Shapes("Rectangle 20")
            .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
End With
End Sub

weiyingde · 发表于 2019-10-29 23:37

rgzyj@163.com 发表于 2019-10-29 14:22
Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape

已经23:37分，腰酸背痛，总算完成了，好用给个回音。

weiyingde · 发表于 2019-10-29 23:39

rgzyj@163.com 发表于 2019-10-29 14:22
Private Sub CommandButton1_Click()
Dim shps As Shapes
Dim shp As Shape

已经23:37分，腰酸背痛，总算完成了，好用给个回音。

		自动登录	找回密码
密码			免费注册

[求助] （未解决）如何根据次数，动态地画出长方形。求帮助

评分

评分

评分

评分

最新热点 /1