📄 frmoutdate.frm
字号:
Width = 2295
End
End
Begin VB.ComboBox cboBalFilter
Height = 276
Index = 0
Left = 3660
Style = 2 'Dropdown List
TabIndex = 26
Top = 540
Visible = 0 'False
Width = 3195
End
Begin VB.ComboBox cboBalFilter
Height = 276
Index = 1
Left = 3660
Style = 2 'Dropdown List
TabIndex = 25
Top = 1020
Visible = 0 'False
Width = 3195
End
Begin VB.ComboBox cboBalFilter
Height = 276
Index = 2
Left = 3660
Style = 2 'Dropdown List
TabIndex = 24
Top = 1500
Visible = 0 'False
Width = 3195
End
Begin MSComDlg.CommonDialog clgOutFileName
Left = -72720
Top = 3480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame4
Caption = "说明"
Height = 1695
Index = 0
Left = -72600
TabIndex = 21
Top = 2100
Width = 4455
Begin VB.Label lblOutDate
Caption = "请选择导出数据格式文件名。"
Height = 375
Index = 0
Left = 1140
TabIndex = 22
Top = 720
Width = 2475
End
End
Begin VB.Frame Frame3
Caption = "说明"
Height = 1695
Left = -72600
TabIndex = 19
Top = 2100
Width = 4455
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "请选择导出项目。"
Height = 375
Left = 600
TabIndex = 20
Top = 840
Width = 2535
End
End
Begin VB.ComboBox cboOutItem
Height = 276
ItemData = "frmOutDate.frx":01EF
Left = -72600
List = "frmOutDate.frx":01F1
Style = 2 'Dropdown List
TabIndex = 18
Top = 900
Width = 4455
End
Begin VB.CommandButton cmdOutDate
Height = 300
Left = -68400
Style = 1 'Graphical
TabIndex = 17
Top = 900
UseMaskColor = -1 'True
Width = 300
End
Begin VB.Frame Frame2
Caption = "已选条件"
Height = 1815
Left = 3090
TabIndex = 13
Top = 2040
Width = 3765
Begin MSFlexGridLib.MSFlexGrid MsgFilter
Height = 1515
Left = 120
TabIndex = 14
Top = 240
Width = 3405
_ExtentX = 6011
_ExtentY = 2667
_Version = 393216
FixedCols = 0
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 3
End
End
Begin VB.Frame Frame1
Caption = "可选项目"
Height = 3255
Left = 240
TabIndex = 8
Top = 570
Width = 2505
Begin MSComctlLib.TreeView tvwFilter
Height = 2865
Left = 120
TabIndex = 9
Top = 240
Visible = 0 'False
Width = 2265
_ExtentX = 4001
_ExtentY = 5059
_Version = 393217
HideSelection = 0 'False
Indentation = 529
LineStyle = 1
Style = 7
BorderStyle = 1
Appearance = 1
End
End
Begin VB.TextBox txtName
Height = 300
Left = -72600
TabIndex = 16
Top = 900
Width = 4215
End
Begin VB.Label lblBalFilter
Caption = "会计年度(&Y)"
Height = 195
Index = 0
Left = 2400
TabIndex = 12
Top = 600
Visible = 0 'False
Width = 1035
End
Begin VB.Label lblBalFilter
Caption = "开始期间(&S)"
Height = 195
Index = 1
Left = 2400
TabIndex = 28
Top = 1080
Visible = 0 'False
Width = 1035
End
Begin VB.Label lblBalFilter
Caption = "结束期间(&E)"
Height = 195
Index = 2
Left = 2400
TabIndex = 27
Top = 1560
Visible = 0 'False
Width = 1035
End
Begin VB.Label lblOutItem
Caption = "导出项目:"
Height = 255
Left = -72600
TabIndex = 23
Top = 600
Width = 855
End
Begin VB.Label LblOutName
Caption = "导出文件名(&R)"
Height = 255
Left = -72600
TabIndex = 15
Top = 600
Width = 1275
End
End
Begin VB.Line linSep
BorderColor = &H00FFFFFF&
Index = 1
X1 = 120
X2 = 7300
Y1 = 4215
Y2 = 4215
End
Begin VB.Line linSep
BorderColor = &H00808080&
Index = 0
X1 = 120
X2 = 7300
Y1 = 4200
Y2 = 4200
End
End
Attribute VB_Name = "frmOutDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private mclsOutFilter As FormCond '筛选对象
Private WithEvents mclsHook As Hook '钩子对象
Attribute mclsHook.VB_VarHelpID = -1
Private mListset As ListSet '筛选项目对象
Private mintViewId(200) As Integer '筛选项目的视图
Private mintItem As Integer '导出项目是否改变标志
Private mblnIsInited(2) As Boolean
Private Sub cboOutItem_Click()
If mintViewId(cboOutItem.ItemData(cboOutItem.ListIndex)) = -1 Then
sstWizard.TabVisible(2) = False
cmdnext.Enabled = False
Else
sstWizard.TabVisible(2) = True
cmdnext.Enabled = True
End If
End Sub
'取消
Private Sub CmdCancel_Click()
Unload Me
End Sub
'完成
Private Sub cmdComplete_Click()
Dim strWhere As String
Dim intResult As Integer
Dim strHaving As String
If sstWizard.TabVisible(2) And Not cboBalFilter(1).Visible And cboOutItem.ItemData(cboOutItem.ListIndex) = 31 Then
sstWizard.Tab = 2
sstWizard_Click 1
End If
If GetFilePath(txtName.Text) = "" Then
ShowMsg Me.hwnd, "你所选择的路径不存在，请重新选择！", vbInformation, Me.Caption
sstWizard.Tab = 0
txtName.SetFocus
Exit Sub
End If
If cboOutItem.ItemData(cboOutItem.ListIndex) = 31 Then
If CInt(cboBalFilter(1).Text) > CInt(cboBalFilter(2).Text) Then
ShowMsg Me.hwnd, "开始期间不能大于结束期间！", vbInformation, Me.Caption
sstWizard.Tab = 2
cboBalFilter(1).SetFocus
Exit Sub
End If
intResult = AccountExport(txtName.Text, cboOutItem.ItemData(cboOutItem.ListIndex), strWhere, CInt(cboBalFilter(0).Text) _
, CInt(cboBalFilter(1).Text), CInt(cboBalFilter(2).Text))
Else
Dim strFrom As String
Dim strTemp As String
Dim strType As String
Dim strWhereInform As String
strFrom = mListset.FromOfSql
strWhereInform = mListset.GetWhereInFrom
If mintItem = cboOutItem.ItemData(cboOutItem.ListIndex) Then
strWhere = mclsOutFilter.GetCond(, , strTemp)
Else
strWhere = ""
End If
If Trim(strWhereInform) <> "" Then
strType = " Where " & strWhereInform & " And ItemActivity.lngReceiptTypeID=" & cboOutItem.ItemData(cboOutItem.ListIndex) - 40
Else
strType = " Where ItemActivity.lngReceiptTypeID=" & cboOutItem.ItemData(cboOutItem.ListIndex) - 40
End If
strHaving = ""
If Trim(strWhere & strTemp) <> "" Then
Select Case cboOutItem.ItemData(cboOutItem.ListIndex) - 40
Case 1 '采购定单
If Trim(strTemp) <> "" Then
strHaving = Trim(strTemp)
End If
Case 12 '销售定单
If Trim(strTemp) <> "" Then
strHaving = Trim(strTemp)
End If
Case 33 '商品盘点
If Trim(strTemp) <> "" Then
strHaving = Trim(strTemp)
End If
Case 2 To 11, 13 To 24
If Trim(strTemp) <> "" Then
strHaving = Trim(strTemp)
End If
Case 42 To 47, 52, 29
strWhere = "(SELECT ItemActivity.lngActivityID " & strFrom & IIf(Trim(strWhere) = "", strType, strType & " and " & strWhere)
If Trim(strTemp) <> "" Then
strWhere = strWhere & " Group by ItemActivity.lngActivityID Having " & strTemp & ")"
Else
strWhere = strWhere & ")"
End If
Case 26, 28
Dim recTemp As rdoResultset
If Trim(strWhereInform) <> "" And Trim(strWhere) <> "" Then
strWhere = "SELECT min(To_char(ItemActivity.lngReceiptTypeID,'0000')+To_char(ItemActivity.intYear)+To_char(ItemActivity.bytPeriod)+(ItemActivity.strReceiptNO)+To_char(ItemActivity.lngReceiptNO)) as RecID " & strFrom & " Where " & strWhereInform & " AND " & strWhere
ElseIf Trim(strWhereInform) <> "" And Trim(strWhere) = "" Then
strWhere = "SELECT min(To_char(ItemActivity.lngReceiptTypeID,'0000')+To_char(ItemActivity.intYear)+To_char(ItemActivity.bytPeriod)+(ItemActivity.strReceiptNO)+To_char(ItemActivity.lngReceiptNO)) as RecID " & strFrom & " Where " & strWhereInform 'IIf(Trim(strWhere) = "", " ", " WHERE " & strWhere)
ElseIf Trim(strWhereInform) = "" And Trim(strWhere) <> "" Then
strWhere = "SELECT min(To_char(ItemActivity.lngReceiptTypeID,'0000')+To_char(ItemActivity.intYear)+To_char(ItemActivity.bytPeriod)+(ItemActivity.strReceiptNO)+To_char(ItemActivity.lngReceiptNO)) as RecID " & strFrom & " Where " & strWhere 'IIf(Trim(strWhere) = "", " ", " WHERE " & strWhere)
End If
strWhere = strWhere & " GROUP BY ItemActivity_1.lngActivityID,ItemActivity_1.lngActivityTypeID,ItemActivity.lngActivityTypeID"
If Trim(strTemp) <> "" Then
strTemp = " HAVING ((ItemActivity_1.lngActivityTypeID)=" _
& IIf(cboOutItem.ItemData(cboOutItem.ListIndex) - 40 = 28, 27, 24) _
& " AND ((ItemActivity.lngActivityTypeID)=" _
& IIf(cboOutItem.ItemData(cboOutItem.ListIndex) - 40 = 28, 28, 25) _
& ")) And" & strTemp
Else
strTemp = " HAVING (ItemActivity_1.lngActivityTypeID)=" _
& IIf(cboOutItem.ItemData(cboOutItem.ListIndex) - 40 = 28, 27, 24) _
& " AND (ItemActivity.lngActivityTypeID)=" _
& IIf(cboOutItem.ItemData(cboOutItem.ListIndex) - 40 = 28, 28, 25)
End If
strWhere = strWhere & strTemp
Set recTemp = gclsBase.BaseDB.OpenResultset(strWhere, rdOpenStatic)
strWhere = "("
Do Until recTemp.EOF
If Len(Trim(strWhere)) <> 1 Then
strWhere = strWhere & "," & recTemp!recID
Else
strWhere = strWhere & recTemp!recID
End If
recTemp.MoveNext
Loop
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -