发布于 2011-07-13 16:50:06
7楼
五楼的盆友 我把我的VBA程序放在上面你给看下 我在想是不是读书非常快而导致的死机 我想编写一个暂停了两秒的程序但是不知道放在那里 请大侠给看看 谢谢 下面是我的VBA程序:
Option Explicit
Dim g_Flag
Private Sub CommandButton1_Click()
Call Excel.Application.Run("OPCS7200Addin.XLA!OPCWrite", "[PCAccessLog.xls]Sheet1!$B$1", 1234)
End Sub
Private Sub CommandButton2_Click()
Dim sStr As String
Dim str As String
Dim s, x, y, z As String
Dim Today
Dim WaitTime
Dim FileNum
Dim S1 As Date, S2 As Date, S3 As Long, SpecMinute As Integer
'
If g_Flag = 0 Then
CommandButton2.Caption = "开始读取数据"
g_Flag = 1
If Cells(4, 7) <> "" Then
FileNum = FreeFile ' next free filenumber
' Open "c:\\textfile.txt" For Append As #FileNum ' appends the input to an existing file
Open Cells(4, 7) For Append As #FileNum ' appends the input to an existing file
'
' Print to the textfile
Print #FileNum, "Date/Time, " & Cells(3, 2) '
End If
Else
CommandButton2.Caption = "停止读取数据"
g_Flag = 0
' Cells(2, 3) = 2
Exit Sub
End If
'
str = ""
'
While g_Flag <> 0
'
Application.ScreenUpdating = False
Today = Now
Cells(Cells(4, 6), 1) = Today
'
str = Today & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 2) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 2) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 3) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 3) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 4) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(2, 6), 4) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 5) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(2, 6), 5) = sStr
'
str = str + sStr
If Cells(4, 7) <> "" Then
' Print to the textfile
Print #FileNum, str ' Output text.
End If
'
DoEvents
Cells(4, 6) = Cells(4, 6) + 1
'
Application.ScreenUpdating = True
SpecMinute = Cells(4, 7)
If SpecMinute <= 0 And SpecMinute > 60 Then Exit Sub
S3 = 0
S1 = Time()
Do
S2 = Time()
S3 = DateDiff("s", S1, S2)
'If Minute(S2) < Minute(S1) Then
'如果转到下一小时,则以上一小时的差加上下一小时已过分钟为间差
'S3 = (60 - Minute(S1)) + Minute(S2)
'Else
'如果在相同小时内,则直接相减即可
'S3 = Minute(S2 - S1)
'End If
DoEvents
Loop While S3 < SpecMinute * 60
x = "E4:" & "E" & Format(Cells(4, 6)) '选择区域
With Workbooks("shujudaochu.xls").Worksheets("weight").ChartObjects(1).Chart
.HasTitle = True
.ChartType = xlXYScatterSmooth
.SetSourceData Source:=Sheets("weight").Range(x), PlotBy:=xlColumns
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
DoEvents
Wend
'
If Cells(4, 7) <> "" Then
Close #FileNum ' close the file
End If
'
End Sub
Private Sub CommandButton3_Click()
Dim s
Dim weight
s = "A4:" & "E" & Format(Cells(4, 6))
With Workbooks("shujudaochuZZ.xls").Worksheets("weight")
.Range(s).Clear
Cells(4, 6) = 4
End With
End Sub
Private Sub CommandButton4_Click()
Dim sStr As String
Dim str As String
Dim s, x, y, z As String
Dim Today
Dim WaitTime
Dim FileNum
Dim S1 As Date, S2 As Date, S3 As Long, SpecMinute As Integer
'
'Call Excel.Application.Run("OPCS7200Addin.XLA!OPCWrite", "[PCAccessLog.xls]Sheet1!$B$1", 1234)
g_Flag = 1
'If g_Flag = 0 Then
'Exit Sub
' If Cells(4, 7) <> "" Then
' FileNum = FreeFile ' next free filenumber
' Open "c:\\textfile.txt" For Append As #FileNum ' appends the input to an existing file
'Open Cells(4, 7) For Append As #FileNum ' appends the input to an existing file
'
' Print to the textfile
'Print #FileNum, "Date/Time, " & Cells(3, 2) '
'End If
'Else
'CommandButton2.Caption = "停止读取数据"
'g_Flag = 0
' Cells(2, 3) = 2
'Exit Sub
'End If
'
str = ""
'
While g_Flag <> 0
'
If g_Flag = 0 Then
Exit Sub
' If Cells(4, 7) <> "" Then
' FileNum = FreeFile ' next free filenumber
' Open "c:\\textfile.txt" For Append As #FileNum ' appends the input to an existing file
'Open Cells(4, 7) For Append As #FileNum ' appends the input to an existing file
'
' Print to the textfile
'Print #FileNum, "Date/Time, " & Cells(3, 2) '
'End If
'Else
'CommandButton2.Caption = "停止读取数据"
'g_Flag = 0
' Cells(2, 3) = 2
'Exit Sub
End If
Application.ScreenUpdating = False
Today = Now
Cells(Cells(4, 6), 1) = Today
'
str = Today & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 2) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 2) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 3) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 3) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 4) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 4) = sStr
'
str = str + sStr & ", "
'
s = "2:0.0.0.0:0000:0000," & Cells(3, 5) & ",REAL,RW"
sStr = Excel.Application.Run("OPCS7200ExcelAddin.XLA!OPCRead", s, "")
Cells(Cells(4, 6), 5) = sStr
'
str = str + sStr
' If Cells(4, 7) <> "" Then
' Print to the textfile
' Print #FileNum, str ' Output text.
'End If
'
DoEvents
' Cells(4, 6) = Cells(4, 6) + 1
'
Application.ScreenUpdating = True
'SpecMinute = Cells(4, 7)
' If SpecMinute <= 0 And SpecMinute > 60 Then Exit Sub
'S3 = 0
'S1 = Time()
'Do
' S2 = Time()
'S3 = DateDiff("s", S1, S2)
'If Minute(S2) < Minute(S1) Then
'如果转到下一小时,则以上一小时的差加上下一小时已过分钟为间差
'S3 = (60 - Minute(S1)) + Minute(S2)
'Else
'如果在相同小时内,则直接相减即可
'S3 = Minute(S2 - S1)
'End If
'DoEvents
' Loop While S3 < SpecMinute * 60
x = "E4:" & "E" & Format(Cells(4, 6)) '选择区域
With Workbooks("shujudaochuZZ.xls").Worksheets("weight").ChartObjects(1).Chart
.HasTitle = True
.ChartType = xlXYScatterSmooth
.SetSourceData Source:=Sheets("weight").Range(x), PlotBy:=xlColumns
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "时间(×" & Format(Cells(4, 7)) & "分钟)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "重量(g)"
End With
y = "C4:" & "C" & Format(Cells(4, 6)) '选择区域
With Workbooks("shujudaochuZZ.xls").Worksheets("weight").ChartObjects(2).Chart
.HasTitle = True
.ChartType = xlXYScatterSmooth
.SetSourceData Source:=Sheets("weight").Range(y), PlotBy:=xlColumns
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "时间(×" & Format(Cells(4, 7)) & "分钟)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "温度(℃)"
End With
z = "B4:" & "B" & Format(Cells(4, 6)) '选择区域
With Workbooks("shujudaochuZZ.xls").Worksheets("weight").ChartObjects(3).Chart
.HasTitle = True
.ChartType = xlXYScatterSmooth
.SetSourceData Source:=Sheets("weight").Range(z), PlotBy:=xlColumns
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "时间(×" & Format(Cells(4, 7)) & "分钟)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "湿度(%)"
End With
ActiveWorkbook.Save
Cells(4, 6) = Cells(4, 6) + 1
SpecMinute = Cells(4, 7)
'If SpecMinute <= 0 And SpecMinute > 60 Then Exit Sub
S3 = 0
S1 = Today
Do
S2 = Now
S3 = DateDiff("s", S1, S2)
'If Minute(S2) < Minute(S1) Then
'如果转到下一小时,则以上一小时的差加上下一小时已过分钟为间差
'S3 = (60 - Minute(S1)) + Minute(S2)
'Else
'如果在相同小时内,则直接相减即可
'S3 = Minute(S2 - S1)
'End If
DoEvents
Loop While S3 < SpecMinute * 60
'DoEvents
Wend
'
'If Cells(4, 7) <> "" Then
'Close #FileNum ' close the file
' End If
End Sub
Private Sub CommandButton5_Click()
g_Flag = 0
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
我是菜鸟 恳请高手给与帮助