?? mdlreport
字號:
Attribute VB_Name = "MdlReport"
Option Explicit
Public Sub ReportDetail(StrSql As String, RptHead As String)
''On error goto Err_Report
Const WidthMultiple = 200, WidthScale = 2
Dim i, j, intWidth, IntLeft, ColumnCount, Num As Integer
Dim RstDetail, RstSize, RstCorp As ADODB.Recordset
Dim Rpt As RptParentDetail
Dim StrSqlSize, StrSqlCorp As String
Dim StrField, StrCaption, StrName, StrValue As String
Dim BlnIsHave, BlnIsStr As Boolean
Set RstDetail = New ADODB.Recordset
Set RstSize = New ADODB.Recordset
Set Rpt = New RptParentDetail
'StrSql = "SELECT Description,StockDescription,Begin_D1,Begin_D2,Begin_D3,Begin_D4,Begin_D5,Begin_D6,Begin_D7," & _
"Begin_D8,Begin_D9,Begin_D10,Begin_D11,Begin_D12,Begin_D13,Begin_D14,Begin_D15,Begin_D16,Begin_D17," & _
"Begin_D18,Begin_D19,Begin_D20,Begin_D21,Begin_D22,Begin_D23,Begin_D24,Begin_D25,Begin_D26,Begin_D27," & _
"Begin_D28,Begin_D29,Begin_D30,Income_D1,Income_D2,Income_D3,Income_D4,Income_D5,Income_D6,Income_D7," & _
"Income_D8,Income_D9,Income_D10,Income_D11,Income_D12,Income_D13,Income_D14,Income_D15,Income_D16,Income_D17," & _
"Income_D18,Income_D19,Income_D20,Income_D21,Income_D22,Income_D23,Income_D24,Income_D25,Income_D26,Income_D27," & _
"Income_D28,Income_D29,Income_D30,Outcome_D1,Outcome_D2,Outcome_D3,Outcome_D4,Outcome_D5,Outcome_D6,Outcome_D7," & _
"Outcome_D8,Outcome_D9,Outcome_D10,Outcome_D11,Outcome_D12,Outcome_D13,Outcome_D14,Outcome_D15,Outcome_D16,Outcome_D17," & _
"Outcome_D18,Outcome_D19,Outcome_D20,Outcome_D21,Outcome_D22,Outcome_D23,Outcome_D24,Outcome_D25,Outcome_D26,Outcome_D27," & _
"Outcome_D28,Outcome_D29,Outcome_D30,Balance_D1,Balance_D2,Balance_D3,Balance_D4,Balance_D5,Balance_D6,Balance_D7," & _
"Balance_D8,Balance_D9,Balance_D10,Balance_D11,Balance_D12,Balance_D13,Balance_D14,Balance_D15,Balance_D16,Balance_D17," & _
"Balance_D18,Balance_D19,Balance_D20,Balance_D21,Balance_D22,Balance_D23,Balance_D24,Balance_D25,Balance_D26,Balance_D27," & _
"Balance_D28,Balance_D29,Balance_D30 FROM V_DayBuySellStockDetail WHERE Year=" & Year(Date) & " AND PeriodNumber=" & Month(Date) & ""
RstDetail.Open StrSql, GetCNClient, adOpenKeyset, adLockOptimistic
If RstDetail.RecordCount > 0 Then RstDetail.MoveFirst
StrSqlSize = "SELECT DISTINCT Description,ID FROM Mis_Size WHERE Attribute=1 AND Size_Type" & _
" " & "IN (SELECT DISTINCT size_type From V_DayBuySellStockDetail" & _
" " & "WHERE Year = " & Year(Date) & " AND PeriodNumber =" & Month(Date) & ") ORDER BY ID"
RstSize.Open StrSqlSize, GetCNClient, adOpenKeyset, adLockOptimistic
If RstSize.RecordCount > 0 Then RstSize.MoveFirst
IntLeft = 0
ColumnCount = 0
BlnIsStr = False
BlnIsHave = False
With Rpt
.DataControl1.Recordset = RstDetail
.LabelHead.Caption = RptHead
.LabelHead.Width = Len(RptHead) * WidthMultiple * WidthScale
.LabelHead.Left = (.Width - .LabelHead.Width) / 2
If (Not RstDetail.EOF) And (Not RstDetail.BOF) Then
For i = 1 To RstDetail.Fields.Count
If IsNumeric(RstDetail.Fields(i - 1).Value) Then
'根據數值寬度凋整報表列寬
If Len(RstDetail.Fields(i - 1).Value) <= 3 Then
intWidth = WidthMultiple * WidthScale
Else
intWidth = Len(RstDetail.Fields(i - 1).Value) * WidthMultiple
End If
If (Not RstSize.EOF) And (Not RstSize.BOF) Then
BlnIsHave = True
ColumnCount = ColumnCount + 1
StrValue = RstSize![ID]
StrCaption = RstSize![Description]
RstSize.MoveNext
End If
Else
'根據數值寬度凋整報表列寬
If Len(RstDetail.Fields(i - 1).Value) < 4 Then
intWidth = (Len(RstDetail.Fields(i - 1).Value) + 1) * WidthMultiple
Else
intWidth = Len(RstDetail.Fields(i - 1).Value) * WidthMultiple
End If
BlnIsHave = True
BlnIsStr = True
ColumnCount = ColumnCount + 1
End If
If BlnIsHave Then
'初始化報表標題
With .PageHeader
StrName = "Label" & Trim(Str(ColumnCount))
.Controls(StrName).Visible = True
If Not BlnIsStr Then .Controls(StrName).Caption = StrCaption
.Controls(StrName).Left = IntLeft
.Controls(StrName).Width = intWidth
End With
'初始化報表細目
With .Detail
If BlnIsStr Then
StrField = RstDetail.Fields(i - 1).name
StrName = "Field" & Trim(Str(ColumnCount))
.Controls(StrName).Visible = True
.Controls(StrName).DataField = StrField
.Controls(StrName).Left = IntLeft
.Controls(StrName).Width = intWidth
.Controls(StrName).OutputFormat = ("##,##0;-##,##0; ;")
.Controls(StrName).Height = .Controls(StrName).Height * 4
BlnIsStr = False
Else
Num = Int(Right(StrValue, 2))
For j = 0 To 3
Select Case j
Case 0: StrField = "Begin_D" & Trim(Str(Num))
Case 1: StrField = "Income_D" & Trim(Str(Num))
Case 2: StrField = "Outcome_D" & Trim(Str(Num))
Case 3: StrField = "Balance_D" & Trim(Str(Num))
End Select
StrName = "Field" & Trim(Str(ColumnCount + j * 32))
.Controls(StrName).Visible = True
.Controls(StrName).DataField = StrField
.Controls(StrName).Left = IntLeft
.Controls(StrName).Width = intWidth
.Controls(StrName).OutputFormat = ("##,##0;-##,##0; ;")
Next j
End If
End With
'遞增變量 IntLeft 用來調整 Left 屬性
IntLeft = IntLeft + intWidth
If i = 2 Then
With .Detail
For j = 1 To 4
StrName = "LabelDetail" & Trim(Str(j))
.Controls(StrName).Left = IntLeft
Next j
intWidth = .Controls(StrName).Width
End With
.LabelDetail.Visible = True
.LabelDetail.Left = IntLeft
.LabelDetail.Width = intWidth
IntLeft = IntLeft + intWidth
End If
End If
BlnIsHave = False
Next i
End If
With .LineHead
.x1 = IntLeft
.x2 = IntLeft
End With
With .LineVertical
.x1 = IntLeft
.x2 = IntLeft
.Y1 = 0
.Y2 = 250 * RstDetail.RecordCount
End With
With .LineHorizontal
.x1 = 0
.x2 = IntLeft
End With
'讀取公司信息(名稱,地址,電話,傳真,Email)
Set RstCorp = New ADODB.Recordset
StrSqlCorp = "SELECT mis_Customer.ContactNum AS CorpID, mis_Customer.ContactName AS CorpName," & _
"Mis_City.captal, Mis_City.city, mis_Customer.Phone, mis_Customer.Fax, mis_Customer.Email, Mis_City.tel" & _
" " & "FROM mis_Customer INNER JOIN AccountName ON mis_Customer.ContactNum = AccountName.WrokCenter INNER JOIN" & _
" " & "Mis_City ON mis_Customer.City = Mis_City.City_ID" & _
" " & "WHERE AccountName.AccountID='" & Trim(strAccountName) & "'"
RstCorp.Open StrSqlCorp, GetCNClient, adOpenKeyset, adLockOptimistic
'初始化報表尾之公司信息
If RstCorp.RecordCount > 0 Then
RstCorp.MoveFirst
.LabelFoot8 = RstCorp.Fields("CorpName")
.LabelFoot10 = RstCorp.Fields("Captal") & RstCorp.Fields("city")
.LabelFoot12 = "(" & RstCorp.Fields("Tel") & ")-" & RstCorp.Fields("Phone")
.LabelFoot14 = RstCorp.Fields("Fax")
.LabelFoot16 = RstCorp.Fields("Email")
Else
End If
.Show 1
End With
'善后處理
RstDetail.Close
RstSize.Close
RstCorp.Close
Set RstDetail = Nothing
Set RstSize = Nothing
Set RstCorp = Nothing
Set Rpt = Nothing
Exit Sub
Err_Report:
mis_HandError Err.Number, "GInitReport"
End Sub
Public Sub ReportModel(EvidenceNum As String, RptExcursus() As String)
''On error goto Err_Report
Const WidthMultiple = 200
Dim i, NumberCount, TextCount As Integer
Dim intWidth, IntLeft, NumWidth As Integer
Dim RstDetail, RstSize, RstCorp, RstEviName As ADODB.Recordset
Dim Rpt As RptModel
Dim StrSql, StrSqlSize, StrSqlCorp, StrSqlEvi As String
Dim StrField, StrCaption, StrName As String
Dim BlnIsHave As Boolean
Set RstDetail = New ADODB.Recordset
Set RstSize = New ADODB.Recordset
Set RstEviName = New ADODB.Recordset
Set Rpt = New RptModel
StrSql = "SELECT Description,Q01,Q02,Q03,Q04,Q05,Q06,Q07,Q08,Q09,Q10,Q11,Q12,Q13," & _
"Q14,Q15,Q16,Q17,Q18,Q19,Q20,Q21,Q22,Q23,Q24,Q25,Q26,Q27,Q28,Q29,Q30 FROM V_EvidenceDetail" & _
" " & "WHERE Evidence_Number='" & EvidenceNum & "'"
RstDetail.Open StrSql, GetCNClient, adOpenKeyset, adLockOptimistic
If RstDetail.RecordCount > 0 Then RstDetail.MoveFirst
'讀取有效配碼
StrSqlSize = "SELECT DISTINCT Description,ID FROM Mis_Size WHERE Attribute=1 AND Size_Type" & _
" " & "IN (SELECT Size_Type FROM V_EvidenceDetail WHERE Evidence_Number='" & _
EvidenceNum & "'" & ") ORDER BY ID"
RstSize.Open StrSqlSize, GetCNClient, adOpenKeyset, adLockOptimistic
If RstSize.RecordCount > 0 Then RstSize.MoveFirst
'讀取單據名稱及日期
StrSqlEvi = " SELECT Evidence_Type.Description AS EvidenceName, Inventory_Evidence.Date " & _
" " & "FROM Evidence_Type INNER JOIN" & _
" " & "Inventory_Evidence ON Evidence_Type.Type = Inventory_Evidence.Type" & _
" " & "WHERE Inventory_Evidence.Evidence_Number = '" & EvidenceNum & "'"
RstEviName.Open StrSqlEvi, GetCNClient, adOpenKeyset, adLockOptimistic
If RstEviName.RecordCount > 0 Then
RstEviName.MoveFirst
Else
Exit Sub
End If
IntLeft = 0
NumberCount = 0
TextCount = 0
With Rpt
.DataControl1.Recordset = RstDetail
'初始化報表頭之單據號,日期,名稱
If (Not RstEviName.EOF) And (Not RstEviName.BOF) Then
.LabelHead = RstEviName![EvidenceName]
.LabelHead8 = EvidenceNum
.LabelHead10 = Format(RstEviName![Date], "yyyy-mm-dd")
End If
'初始化報表頭之附加區(具體內容由參數 RptTitle 傳進)
If UBound(RptExcursus) > 0 Then
.Shape1.Visible = True
.Shape1.Width = .Width
End If
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -