|
Private Sub CommandButton1_Click()
Dim thisyear As Date
thisyear = DateSerial(Year(Now), Month(Now), Day(Now))
If thisyear > #12/30/2013# Then
MsgBox "由于软件问题,此程序已报废,请与开发者联系!"
Exit Sub
Else
'****************************************************************************************
If Op1.Value Then '高程横坡
For i = 1 To 22
Randomize
Sheets(1).Cells(13 + i, 5) = Int(Rnd * (Cells(3, 3) - Cells(3, 2)) + Cells(3, 2))
Randomize
Sheets(1).Cells(51 + i, 5) = Int(Rnd * (Cells(3, 3) - Cells(3, 2)) + Cells(3, 2))
Randomize
Sheets(1).Cells(13 + i, 13) = Int(Rnd * (Cells(3, 9) - Cells(3, 8)) + Cells(3, 8))
Randomize
Sheets(1).Cells(51 + i, 13) = Int(Rnd * (Cells(3, 9) - Cells(3, 8)) + Cells(3, 8))
Next i
ElseIf Op2.Value Then '宽度
For i = 1 To 25
Randomize
Sheets(1).Cells(13 + i, 5) = Int(Rnd * (Cells(4, 3) - Cells(4, 2)) + Cells(4, 2))
Randomize
Sheets(1).Cells(13 + i, 10) = Int(Rnd * (Cells(4, 3) - Cells(4, 2)) + Cells(4, 2))
Next i
ElseIf Op3.Value Then '平整度
For i = 1 To 25
For j = 1 To 10
Randomize
Sheets(1).Cells(14 + i, 2 + j) = Int(Rnd * (Cells(5, 3) - Cells(5, 2)) + Cells(5, 2))
Next j
Next i
ElseIf Op4.Value Then '中线偏位
For i = 1 To 29
For j = 1 To 2
Randomize
Sheets(1).Cells(15 + i, 5 + j) = Int(Rnd * (Cells(6, 3) - Cells(6, 2)) + Cells(6, 2))
Randomize
Sheets(1).Cells(62 + i, 5 + j) = Int(Rnd * (Cells(6, 3) - Cells(6, 2)) + Cells(6, 2))
Next j
Next i
End If
'************************************************************
End If
End Sub
Private Sub CommandButton2_Click()
Sheets(1).Select
Sheets(1).Copy before:=Sheets(1)
Sheets("(模板表)").Select
End Sub
资料模版.rar
(37.58 KB, 下载次数: 5)
|
|