征源码

[fsccqq]

征程序源码，通过选择时间段，查询sql server中一个表符合要求的纪录，并提供打印功能。源码请email:[e-mail]

[flc]

关注

[newrobin]

打印？还是报表？
呵呵，分低了点吧

[kmzs]

关注

[TT008]

'****************查询两个时间段
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connstr As String

Sub adoT()
connstr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
conn.Open connstr
rs.CursorLocation = adUseClient
rs.Close
conn.Close
End Sub



Private Sub DTPicker1_Change()
On Error Resume Next
Text1.Text = Format(DTPicker1.Value, "YYYY-MM-DD")
End Sub

Private Sub DTPicker1_Click()
Text1.Text = Format(DTPicker1.Value, "YYYY-MM-DD")
End Sub

Private Sub DTPicker2_Change()
On Error Resume Next
Text2.Text = Format(DTPicker2.Value, "YYYY-MM-DD")
End Sub

Private Sub DTPicker2_Click()
Text2.Text = Format(DTPicker2.Value, "YYYY-MM-DD")
End Sub

Sub finddata()
On Error Resume Next
adoT
conn.Open connstr
Sql = "select * from table where data between '" & Text1.Text & "' and '" & Text2.Text & "' order by id desc"
rs.Open Sql, conn, adOpenKeyset, adLockPessimistic
Set DataGrid1.DataSource = rs
End Sub
'*************** 打印
Private Sub Command1_Click()
On Error Resume Next
Sql = "select * from table where data between '" & Text1.Text & "' and '" & Text2.Text & "' order by id desc"
ToExcel (Sql)
End Sub
'***************** ToExcel模块
Public Function ToExcel(strOpen As String)

Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer

Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
Dim T As Excel.Workbook
With Rs_Data
If .State = adStateOpen Then
.Close
End If
.ActiveConnection = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strOpen
.Open
End With
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Function
End If

Irowcount = .RecordCount
Icolcount = .Fields.Count
End With

'set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().Add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.AlertBeforeOverwriting = False

Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a2"))
With xlQuery
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
End With
xlQuery.FieldNames = True
xlQuery.Refresh
xlApp.Application.Visible = True
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
End Function

[davidlv]

学习一下

[qingming81]

时间左右加#号：
Sql = "select * from table where data between '#" & Text1.Text & "#' and '#" & Text2.Text & "#' order by id desc"