救急!救火!!!关于vba 编程!!!在线等:(

飞狼兄 2004-04-29 04:13:35
老总要一个效果。在exceL里!
做一个按钮,你点开始,就会每15秒随机变化颜色一次,颜色在红,蓝,黑 里变化!到了600秒,即40次后停止!!!然后显示一个停止字样!!!
我没有学过VB!!!!大家救救我!!!1个小时后要:((
...全文
47 4 打赏 收藏 举报
写回复
4 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
343 2004-04-30
Sub Macro1()
'
' If B4=0 the number of Red, Yellow, and Blue are EXACTLY 20, 10, 10
' If B4=1 then it is random in the proportions 2:1:1
'
Application.ScreenUpdating = False
Calculate
Sheets("Sheet1").Select
Numperiods = Range("D5").Value + 1
If Sheets("Sheet1").Range("B4").Value = 1 Then
Sheets("Sheet2").Select
Range("D1:D80").Select
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Else
Sheets("Sheet2").Select
Range("F1:F80").Select
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(Numperiods, 2)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
Sheets("Sheet1").Select
Range("A1").Activate
Range("C2").Value = 0
Range("C4").ClearContents
Demora = Range("D4")
For I = 1 To Numperiods
Beep
Beep
If Demora > 0 Then
Dem2 = Demora
Else
Dem2 = Range("D6").Value
If Dem2 < 5 Then
Dem2 = 5
End If
If Dem2 > -3 * Demora Then
Dem2 = -3 * Demora
End If
End If
Temps = Now()
Final = 3600 * Hour(Temps) + 60 * Minute(Temps) + Second(Temps) + Dem2
Queden = Dem2
While Queden > 0
Temps = Now()
Ara = 3600 * Hour(Temps) + 60 * Minute(Temps) + Second(Temps)
Queden = Final - Ara
Sheets("Sheet1").Range("C3").Value = Queden
Wend
If I < Numperiods Then
Sheets("Sheet1").Range("C2").Value = I
ww = "B" & I
xx = Sheets("Sheet2").Range(ww).Value
Sheets("Sheet1").Range("C4").Value = xx
Else
Sheets("Sheet1").Range("C4").Value = "STOP"
Sheets("Sheet1").Range("C2").Value = "STOP"
End If
Next I
Range("B3").ClearContents
End Sub
  • 打赏
  • 举报
回复
艺文Queen 2004-04-29
nihao为按钮的名字
Private Sub Workbook_Open()
Sheet2.nihao.BackColor = RGB(255, 0, 0)
End Sub

Private Sub IeTimer1_Timer()'是在工具箱中添加的timer object
Static f As Integer
Select Case nihao.BackColor
Case RGB(255, 0, 0)
nihao.BackColor = RGB(0, 0, 255)
Case RGB(0, 0, 255)
nihao.BackColor = RGB(0, 0, 0)
Case RGB(0, 0, 0)
nihao.BackColor = RGB(255, 0, 0)
End Select
f = f + 1
If f = 40 Then
IeTimer1.Interval = 0
End If
End Sub

Private Sub nihao_Click()
IeTimer1.Interval = 15000
End Sub
  • 打赏
  • 举报
回复
飞狼兄 2004-04-29
定!再没人!我就删了:(
  • 打赏
  • 举报
回复
飞狼兄 2004-04-29
好了!但是怎么做一个按钮!让这个宏停止运行???
  • 打赏
  • 举报
回复
相关推荐
发帖
Office开发/ VBA
加入

5060

社区成员

其他开发语言 Office开发/ VBA
社区管理员
  • Office开发/ VBA社区
申请成为版主
帖子事件
创建了帖子
2004-04-29 04:13
社区公告
暂无公告