ifix:如何禁止excel报表被修改 点击：5330 | 回复：18
发表于：2005-09-30 09:48:00
16楼
用Excel做报表本身很简单，主要是工艺不同要求不同略有复杂，如下为偶们一工程中做的一小报表源程序：
'读数据传到excel
Public Sub SendExcel()
Dim pa, date1, date2 As String
Dim i, j, k As Integer
Dim Ct As Object
Dim xlBook As excel.Workbook
Dim xlSheet As excel.Worksheet
Dim Temp As String
Dim Rage As String
Dim sTemp As String
Dim FsTemp As String
Dim TsTemp As String
Dim LenTemp As Integer
Dim kf As Integer
Dim Ye As Integer
Dim HourNum As Integer
Dim ex
Dim exwbook
Dim Pass As String
Dim PNum As Integer
Set ConnDb = New ADODB.Connection
pa = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Report-Index.mdb" & ";User ID=;Password=;"
ConnDb.Open pa
ConnDb.CursorLocation = adUseClient
Sql = "select * from ChooseIndex where ReportName='" & Combo1 & "'"
Set rs3 = ConnDb.Execute(Sql)
Expath = App.Path & "\" & rs3("DataName") & "Index.xls"
Dim p1 As String
Dim p2 As String
On Error Resume Next
Set ex = CreateObject("Excel.Application")
Set exwbook = ex.Workbooks.Open(Expath)
Set xlSheet = ex.Worksheets(rs3("ModeNum"))
ex.Sheets(rs3("ModeNum")).Select
Set ConnWZ = New ADODB.Connection
pa = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\DataLog\" & rs3("DataName") & ".mdb ;User ID=;Password=;"
ConnWZ.Open pa
ConnWZ.CursorLocation = adUseClient
Sql = "select * from [" & rs3("DataName") & "Index] where ModeNum =" & rs3("ModeNum")
If rs3("DataName") = "Runtime" Then
Set rs = ConnDb.Execute(Sql)
Do While Not rs.EOF
If rs("TagName") <> "" Then
Sql = "select * from TagTable where TagName= '" & rs("TagName") & "'"
Set rs1 = ConnWZ.Execute(Sql)
Sql2 = "select top 1 * from FloatTable where TagIndex= " & rs1("TagIndex") & _
" and dateandtime>#" & DateNow.CurrentDate + 1 & " # and dateandtime < # " & _
DateNow.CurrentDate + 2 & " #"
Sql1 = "select top 1 * from FloatTable where TagIndex= " & rs1("TagIndex") & _
" and dateandtime>#" & DateNow.CurrentDate & " # and dateandtime < # " & _
DateNow.CurrentDate + 1 & " #"
Set rs2 = ConnWZ.Execute(Sql2)
Set rs4 = ConnWZ.Execute(Sql1)
If rs("LineNum") > 0 And rs("RowNum") > 0 Then
xlSheet.Cells(rs("LineNum") + 9, rs("RowNum") + 1) = rs("TagInfo")
HourNum = ((rs2("val") - rs4("val")) / rs("TagCoef"))
If HourNum > 24 Then
HourNum = 24
Else
If HourNum < 0 Then
HourNum = 0
End If
End If
xlSheet.Cells(rs("LineNum") + 9, rs("RowNum") + 3) = CStr(HourNum)
xlSheet.Cells(rs("LineNum") + 9, rs("RowNum") + 4) = CStr((rs2("val")) / rs("TagCoef"))
End If
End If
rs.MoveNext
Loop
xlSheet.Cells(10, 27) = rs6("Station")
xlSheet.Cells(10, 28) = DateNow.CurrentDate
Else
Set rs = ConnDb.Execute(Sql)
Do While Not rs.EOF
If rs("TagName") <> "" Then
Sql = "select * from TagTable where TagName= '" & rs("TagName") & "'"
Set rs1 = ConnWZ.Execute(Sql)
Set rs2 = ConnWZ.Execute(" DROP VIEW V_Employees")
Sql = "Create View V_Employees As select * from FloatTable where TagIndex= " & rs1("TagIndex") & _
" and dateandtime>#" & DateNow.CurrentDate & " # and dateandtime < # " & _
DateNow.CurrentDate + 1 & " #"
Set rs2 = ConnWZ.Execute(Sql)
For k = 0 To 23
Sql = "select top 1 val from V_Employees where hour(dateandtime) = " & k
Set rs2 = ConnWZ.Execute(Sql)
If rs("RowNum") > 0 Then
If rs("RowNum") > 28 Then
Sql1 = "select top 1 * from FloatTable where TagIndex= " & rs1("TagIndex") & _
" and dateandtime>#" & DateNow.CurrentDate + 1 & " # and dateandtime < # " & _
DateNow.CurrentDate + 2 & " # and hour(dateandtime) =0 "
Set rs4 = ConnWZ.Execute(Sql1)
xlSheet.Cells(k + 10, rs("RowNum") + 1) = (rs4("val") - rs2("val")) / rs("TagCoef")
k = 24
Else
xlSheet.Cells(k + 10, rs("RowNum") + 1) = (rs2("val") / rs("TagCoef"))
End If
End If
Next k
If rs("ShortName") <> "" Then
xlSheet.Cells(24 + 10, rs("RowNum") + 1) = rs("ShortName")
End If
End If
If rs3("DataName") = "Cooler" Then
xlSheet.Cells(10, 27) = rs6("Station")
xlSheet.Cells(10, 28) = DateNow.CurrentDate
xlSheet.Cells(10, 29) = rs3("CoolerNum")
Else
xlSheet.Cells(10, 27) = rs6("Station")
xlSheet.Cells(10, 28) = DateNow.CurrentDate
End If
rs.MoveNext
Loop
End If
Label2.Visible = False
ex.Sheets(rs3("ModeNum")).Select
ex.Sheets(rs3("ModeNum")).Move
ex.ActiveWorkbook.SaveAs FileName:= _
"d:\report\" & Combo1.Text & DateNow.CurrentDate & ".xls ", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
pa = (rs3("DataName") & "Index.xls")
ex.Windows(pa).Activate
ex.ActiveWindow.Close savechanges:=False
ex.Application.DisplayFormulaBar = False
ex.Application.CommandBars("Standard").Visible = False
ex.Application.CommandBars("Formatting").Visible = False
ex.Visible = True
ex.Close
'
SendExcelCom.Enabled = True
End Sub
热门招聘
相关主题
- 寻求max232烧坏的原因
[2694] - 哪里能下载FIX7。0使用手册[2452]
- 西门子S7-300PLC符号表和变量...[8132]
- DAQBench序列号？[2231]
- 如何打开后缀为EXB的文件[2944]
- 每天电脑重启后打开SIMATIC ...[2100]
- IEC61131-3国际编程标准[5174]
- 组态王和Ｓ７２００的通讯问题...[2919]
- FTP资料下载地址连载!!!需要...[3720]
- S7-300如何初始化[2167]
官方公众号
智造工程师
-
客服
-
小程序
-
公众号
工控网智造工程师好文精选
