?? dareportsk.dsr
字號:
Object.Left = 3969
Object.Top = 3402
Object.Width = 1125
Object.Height = 570
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "0"
EndProperty
ItemType46 = 3
BeginProperty Item46 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label6"
Object.Left = 3969
Object.Top = 3969
Object.Width = 1125
Object.Height = 570
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "0"
EndProperty
ItemType47 = 3
BeginProperty Item47 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label11"
Object.Left = 3969
Object.Top = 6803
Object.Width = 1125
Object.Height = 570
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "0"
EndProperty
EndProperty
SectionCode3 = 7
BeginProperty Section3 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Section3"
Object.Height = 870
NumControls = 0
EndProperty
SectionCode4 = 8
BeginProperty Section4 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Section5"
Object.Height = 360
NumControls = 0
EndProperty
End
Attribute VB_Name = "Dareportsjyzb1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub DataReport_Initialize()
Dim m_xm(35) As String
Dim m_bq(6) As Variant
Dim m_bl(5) As Variant
Dim m_yys(5) As String
Dim i, j As Integer
m_yys(0) = "本期"
m_yys(1) = "移動"
m_yys(2) = "聯通"
m_yys(3) = "電信"
m_yys(4) = "網通"
m_yys(5) = "其他"
Dim m_xmbq As Variant
Dim m_ydbq As Variant
Dim m_ltbq As Variant
Dim m_dxbq As Variant
Dim m_wtbq As Variant
Dim m_qtbq As Variant
Dim m_ydbl As Variant
Dim m_ltbl As Variant
Dim m_dxbl As Variant
Dim m_wtbl As Variant
Dim m_qtbl As Variant
Dim str As String
Dim AdoCon As New ADODB.Connection
Const iW = 3 '緹,誤差調整
Printer.PaperSize = 9
Dareportsk.ReportWidth = Printer.Width - Dareportsk.LeftMargin - Dareportsk.RightMargin - iW
Dim AdoRec As New ADODB.Recordset
Dim txt As New Collection
Dim ctl As Object
Dim ctl1 As Object
'AdoCon.Open "Provider=SQLOLEDB.1;Password=db0822;Persist Security Info=True;User ID=sa;Initial Catalog=htgl;Data Source=JX"
AdoCon.Open nowconnectstring
AdoCon.Execute ("delete from bbsk")
AdoRec.Open "select * from dyxx", AdoCon
m_xm(0) = "本期到款金額"
m_xm(1) = "本期應收金額"
j = 2
Do While Not AdoRec.EOF
m_xm(j) = AdoRec.Fields("dymc").Value
AdoRec.MoveNext
j = j + 1
Loop
AdoRec.Close
For i = 0 To 34
For j = 0 To 5
m_bq(j) = 0
Next j
For j = 0 To 4
m_bl(j) = 0
Next j
Select Case i
Case 0
' AdoRec.Close
AdoRec.Open "select sum(dk) as aa from hetong ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(0) = AdoRec.Fields("aa").Value
End If
AdoRec.Close
If m_bq(0) = 0 Then
GoTo l0
End If
AdoRec.Open "select sum(dk) as aa from hetong where yys like '%移動%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(1) = AdoRec.Fields("aa").Value
m_bl(0) = m_bq(1) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(dk) as aa from hetong where yys like '%聯通%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(2) = AdoRec.Fields("aa").Value
m_bl(1) = m_bq(2) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(dk) as aa from hetong where yys like '%電信%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(3) = AdoRec.Fields("aa").Value
m_bl(2) = m_bq(3) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(dk) as aa from hetong where yys like '%網通%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(4) = AdoRec.Fields("aa").Value
m_bl(3) = m_bq(4) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(dk) as aa from hetong where yys like '%其他%' or yys like '%郵政%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(5) = AdoRec.Fields("aa").Value
m_bl(4) = m_bq(5) / m_bq(0)
End If
AdoRec.Close
l0:
'AdoCon.Execute ("DBCC CHECKIDENT (bbsk, RESEED, 0)")
str = "insert into bbsk (xm,bqzs,ydbq,ydbl,ltbq,ltbl,dxbq,dxbl,wtbq,wtbl,qtbq,qtbl) values('" & m_xm(i) & "'," & m_bq(0) & "," & m_bq(1) & "," & m_bl(0) & "," & m_bq(2) & "," & m_bl(1) & "," & m_bq(3) & "," & m_bl(2) & "," & m_bq(4) & "," & m_bl(3) & "," & m_bq(5) & "," & m_bl(4) & ")"
AdoCon.Execute str
Case 1
AdoRec.Open "select sum(yinszk) as aa from hetong ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(0) = AdoRec.Fields("aa").Value
End If
AdoRec.Close
If m_bq(0) = 0 Then
GoTo l1
End If
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%移動%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(1) = AdoRec.Fields("aa").Value
m_bl(0) = m_bq(1) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%聯通%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(2) = AdoRec.Fields("aa").Value
m_bl(1) = m_bq(2) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%電信%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(3) = AdoRec.Fields("aa").Value
m_bl(2) = m_bq(3) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%網通%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(4) = AdoRec.Fields("aa").Value
m_bl(3) = m_bq(4) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%其他%' or yys like '%郵政%' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(5) = AdoRec.Fields("aa").Value
m_bl(4) = m_bq(5) / m_bq(0)
End If
AdoRec.Close
l1:
'AdoCon.Execute ("DBCC CHECKIDENT (bbsk, RESEED, 0)")
str = "insert into bbsk (xm,bqzs,ydbq,ydbl,ltbq,ltbl,dxbq,dxbl,wtbq,wtbl,qtbq,qtbl) values('" & m_xm(i) & "'," & m_bq(0) & "," & m_bq(1) & "," & m_bl(0) & "," & m_bq(2) & "," & m_bl(1) & "," & m_bq(3) & "," & m_bl(2) & "," & m_bq(4) & "," & m_bl(3) & "," & m_bq(5) & "," & m_bl(4) & ")"
AdoCon.Execute str
Case Else
'm_xm(I) = "本期應收賬款金額"
AdoRec.Open "select sum(yinszk) as aa from hetong where dymc like '" & m_xm(i) & "'", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(0) = AdoRec.Fields("aa").Value
End If
AdoRec.Close
If m_bq(0) = 0 Then
GoTo l2
End If
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%移動%' and dymc like '" & m_xm(i) & "'", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(1) = AdoRec.Fields("aa").Value
m_bl(0) = m_bq(1) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%聯通%' and dymc like '" & m_xm(i) & "' ", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(2) = AdoRec.Fields("aa").Value
m_bl(1) = m_bq(2) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%電信%' and dymc like '" & m_xm(i) & "'", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(3) = AdoRec.Fields("aa").Value
m_bl(2) = m_bq(3) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where yys like '%網通%' and dymc like '" & m_xm(i) & "'", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(4) = AdoRec.Fields("aa").Value
m_bl(3) = m_bq(4) / m_bq(0)
End If
AdoRec.Close
AdoRec.Open "select sum(yinszk) as aa from hetong where (yys like '%其他%' or yys like '%郵政%') and dymc like '" & m_xm(i) & "'", AdoCon
If Not IsNull(AdoRec.Fields("aa").Value) Then
m_bq(5) = AdoRec.Fields("aa").Value
m_bl(4) = m_bq(5) / m_bq(0)
End If
AdoRec.Close
l2:
'AdoCon.Execute ("DBCC CHECKIDENT (bbds, RESEED, 0)")
If (m_bq(0) + m_bq(1) + m_bq(2) + m_bq(3) + m_bq(4)) > 0 Then
str = "insert into bbsk (xm,bqzs,ydbq,ydbl,ltbq,ltbl,dxbq,dxbl,wtbq,wtbl,qtbq,qtbl) values('" & m_xm(i) & "'," & m_bq(0) & "," & m_bq(1) & "," & m_bl(0) & "," & m_bq(2) & "," & m_bl(1) & "," & m_bq(3) & "," & m_bl(2) & "," & m_bq(4) & "," & m_bl(3) & "," & m_bq(5) & "," & m_bl(4) & ")"
AdoCon.Execute str
End If
End Select
Next i
DataEnvironment1.rscmd1.Requery
'AdoCon.Execute "DROP TABLE aa"
'AdoCon.Execute "select IDENTITY(INT)AS xuhao,htbh,htmc,qdsj,kpsj,kpje,yjskje,fzr,yys,dymc into aa from hetong where wgqk like '%未完工%' and qdsj>'" & starttime & "' and qdsj<'" & endtime & "' order by kpsj"
'AdoRec.Open "select * from bbsk ", AdoCon
' Set Dareportsk.DataSource = AdoRec
For Each ctl1 In Me.Sections.Item("Section2").Controls
If TypeName(ctl1) = "RptLabel" Then
Select Case ctl1.Name
Case "Label21"
ctl1.Caption = "起始時間：" & starttime
Case "Label23"
ctl1.Caption = "截至時間：" & endtime
End Select
End If
Next
'For Each ctl In Me.Sections.Item("Section1").Controls
' If TypeName(ctl) = "RptTextBox" Then
' Select Case ctl.Name
' Case "Text1"
'ctl.DataField = AdoRec.Fields("xm").Name
' Case "Text2"
' ctl.DataField = AdoRec.Fields("bqzs").Name
' Case "Text3"
' ctl.DataField = AdoRec.Fields("ydbq").Name
' Case "Text4"
'ctl.DataField = AdoRec.Fields("ydbl").Name
' Case "Text5"
'ctl.DataField = AdoRec.Fields("ltbq").Name
'Case "Text6"
' ctl.DataField = AdoRec.Fields("ltbl").Name
' Case "Text7"
'ctl.DataField = AdoRec.Fields("dxbq").Name
' Case "Text8"
'ctl.DataField = AdoRec.Fields("dxbl").Name
' Case "Text9"
'ctl.DataField = AdoRec.Fields("wtbq").Name
' Case "Text10"
'ctl.DataField = AdoRec.Fields("wtbl").Name
' Case "Text11"
'ctl.DataField = AdoRec.Fields("qtbq").Name
' Case "Text12"
' ctl.DataField = AdoRec.Fields("qtbl").Name
' End Select
' End If
' Next
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -