ifix:如何禁止excel报表被修改 点击：5481 | 回复：37
发表于：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
热门招聘
相关主题
- EPLAN 2022稳定版，解决卡顿问...
[8741] - 三谁能告诉我安装三菱中文版...[2564]
- “ChatGPT”能回答工控问题吗？...[2609]
- 关于力控和组态王[5217]
- WinCC项目实例[2363]
- 免费的3D组态软件态神v0.9携...[10508]
- 西门子精智系列触摸屏如何设...[3031]
- 各位高手,有谁编过用电脑控制...[3020]
- 求助：关于组态（上位机）与PLC...[3938]
- 虚拟机安装FANUC的ROBOGUIDE...[7392]
官方公众号
智造工程师
-
客服
-
小程序
-
公众号
工控网智造工程师好文精选
