ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: rgzyj@163.com

[求助] (未解决)如何根据次数,动态地画出长方形。求帮助

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-30 08:56 | 显示全部楼层
基本就是这个样子,有不明白的地方,还要向您请教。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-30 13:45 | 显示全部楼层
本帖最后由 rgzyj@163.com 于 2019-10-30 19:50 编辑

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次牌,刷新一次)

TA的精华主题

TA的得分主题

发表于 2019-10-31 16:35 | 显示全部楼层
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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-31 19:49 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-31 21:27 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 rgzyj@163.com 于 2019-10-31 21:56 编辑
weiyingde 发表于 2019-10-31 16:35
1、用label控件作显示,存在一个刷新的延迟的问题,若事先隐藏再显示的话,则可能出现要先的字符不能变化的 ...

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

求大神帮帮忙啊
   

TA的精华主题

TA的得分主题

发表于 2019-11-1 09:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 weiyingde 于 2019-11-1 09:59 编辑
rgzyj@163.com 发表于 2019-10-31 21:27
非常感谢!
1.  if 摸的次数i是10的倍数 then  
上面的条件语句怎么写?

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-11-1 10:01 | 显示全部楼层
附件如下,请参阅。

共摸10的倍次.rar

60.68 KB, 下载次数: 4

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-1 11:51 | 显示全部楼层
weiyingde 发表于 2019-11-1 10:01
附件如下,请参阅。

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

TA的精华主题

TA的得分主题

发表于 2019-11-1 12:17 | 显示全部楼层
rgzyj@163.com 发表于 2019-11-1 11:51
非常感谢。通过这个例子学会了很多,知道了怎么通过语言控制页面中的元素,显示内容不一定非得用标签控件 ...

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-2 16:51 | 显示全部楼层
本帖最后由 rgzyj@163.com 于 2019-11-2 16:58 编辑
weiyingde 发表于 2019-11-1 12:17
不谢不谢,共同学习,一起进步。

求教:

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

2.       tm1 = Timer  '控制时间
           Do
             DoEvents
        Loop While Timer - tm1 < 0.01
上面这几行分别是什么意思?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 19:23 , Processed in 0.071195 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表