‘- 優雅的頽廢。 2019-07-09 11:05 采纳率: 50%
浏览 185
已结题

需要一个人员抽点的程序,显示的界面能够看到出场的顺序,以及能够控制出场的人员,抽点到指定的人员。

需要一个人员抽点的程序,能够实现抽点到的人员是可控制的,想抽到谁就可以抽到谁。

  • 写回答

1条回答 默认 最新

  • threenewbee 2019-07-09 11:52
    关注

    图片说明

    使用方法,编辑names文件,每个名字1行
    注意,需要抽取的人,名字后面加上一个空格
    不希望抽取的人,不要加
    则程序滚动的时候,所有人都参与滚动,停止的时候,有空格的才会出来

    Option Explicit
    
    Private isRunning As Boolean
    Dim names() As String
    
    Private Sub CommandButton1_Click()
        CommandButton1.Enabled = False
        Dim filecontent As String
        Open "names.txt" For Binary As #1
            filecontent = Input(LOF(1), #1)
        Close #1
        names = Split(filecontent, vbCrLf)
        Randomize
        isRunning = True
        While isRunning
            TextBox1.Text = RndName(False)
            DoEvents
        Wend
        TextBox1.Text = RndName(True)
        If TextBox1.Text = "" Then CommandButton1.Enabled = True: Exit Sub
        If Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text <> "" Then Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text = Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text & ","
        Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text = Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text & TextBox1.Text
        CommandButton1.Enabled = True
    End Sub
    
    Private Function RndName(isSpec As Boolean) As String
        Dim cnt As Long
        cnt = 1
        Dim idx As Long
        Do
            cnt = cnt + 1
            If cnt > 99999 Then
                RndName = ""
                Exit Function
            End If
            idx = Int(Rnd * (UBound(names) - LBound(names) + 1)) + LBound(names)
            If Not IsExist(names(idx)) Then
                If isSpec Then
                    If (names(idx) <> Trim(names(idx))) Then
                        RndName = Trim(names(idx))
                        Exit Do
                    End If
                Else
                    RndName = Trim(names(idx))
                    Exit Do
                End If
            End If
        Loop
    End Function
    
    Private Function IsExist(name As String) As Boolean
        Dim arr() As String
        arr = Split(Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text, ",")
        Dim i As Long
        For i = LBound(arr) To UBound(arr)
            If Trim(name) = Trim(arr(i)) Then
                IsExist = True
                Exit Function
            End If
        Next
        IsExist = False
    End Function
    
    Private Sub CommandButton2_Click()
        isRunning = False
    End Sub
    
    

    其他人如果也需要:https://download.csdn.net/download/caozhy/11311604

    评论

报告相同问题?

悬赏问题

  • ¥15 数学的三元一次方程求解
  • ¥20 iqoo11 如何下载安装工程模式
  • ¥15 本题的答案是不是有问题
  • ¥15 关于#r语言#的问题:(svydesign)为什么在一个大的数据集中抽取了一个小数据集
  • ¥15 C++使用Gunplot
  • ¥15 这个电路是如何实现路灯控制器的,原理是什么,怎么求解灯亮起后熄灭的时间如图?
  • ¥15 matlab数字图像处理频率域滤波
  • ¥15 在abaqus做了二维正交切削模型,给刀具添加了超声振动条件后输出切削力为什么比普通切削增大这么多
  • ¥15 ELGamal和paillier计算效率谁快?
  • ¥15 蓝桥杯单片机第十三届第一场,整点继电器吸合,5s后断开出现了问题