📄 frmreport.frm
字号:
Width = 1455
End
Begin VB.CommandButton cmdPrintSales
Caption = "打印（&P）"
Height = 375
Left = 9600
TabIndex = 9
Top = 1440
Width = 1440
End
Begin VB.Frame frameSalesPeriod
Caption = " 报告时段"
Height = 1215
Left = 240
TabIndex = 33
Top = 120
Width = 4335
Begin MSComCtl2.DTPicker DTSalesEnd
Height = 375
Left = 2760
TabIndex = 3
Top = 480
Width = 1305
_ExtentX = 2302
_ExtentY = 661
_Version = 393216
Format = 104005633
CurrentDate = 37310
End
Begin MSComCtl2.DTPicker DTSalesStart
Height = 375
Left = 840
TabIndex = 2
Top = 480
Width = 1305
_ExtentX = 2302
_ExtentY = 661
_Version = 393216
Format = 104005633
CurrentDate = 37310
End
Begin VB.Label Label2
Caption = "到"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2400
TabIndex = 35
Top = 480
Width = 255
End
Begin VB.Label Label1
Caption = "自"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 34
Top = 480
Width = 375
End
End
Begin VB.CommandButton cmdFlexSalesToExcel
Caption = "导出内容到Excel"
Height = 375
Left = 7080
TabIndex = 8
Top = 1440
Width = 1920
End
Begin VB.CommandButton cmdGenerateReport
Caption = "生成报告(&G)"
Height = 375
Left = 4800
TabIndex = 7
Top = 1440
Width = 1680
End
Begin VB.Frame Frame2
Caption = "筛选优先级 2 > 1"
Height = 1215
Left = 4800
TabIndex = 43
Top = 120
Width = 3495
End
Begin VB.Label lblTotalSales
Caption = "总销售额："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 8400
TabIndex = 36
Top = 240
Width = 1215
End
End
Begin MSFlexGridLib.MSFlexGrid FlexSales
Height = 4215
Left = 240
TabIndex = 1
Top = 600
Width = 11175
_ExtentX = 19711
_ExtentY = 7435
_Version = 393216
Cols = 9
AllowUserResizing= 3
End
Begin VB.Label lblFlexSalesCaption
AutoSize = -1 'True
Caption = "从 :"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 240
TabIndex = 31
Top = 345
Width = 405
End
End
Begin MSComctlLib.TabStrip TabStrip1
Height = 7575
Left = 0
TabIndex = 0
Top = 0
Width = 11775
_ExtentX = 20770
_ExtentY = 13361
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 3
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "租赁销售记录"
Key = "Income"
Object.ToolTipText = "Income"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "文籍租赁统计"
Key = "Movie Statistics"
Object.ToolTipText = "Movie Statistics"
ImageVarType = 2
EndProperty
BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "今日到期/失损项目列表"
Key = "LIRT"
Object.ToolTipText = "List of Items to be Returned Today"
ImageVarType = 2
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub chkActor_Click()
If chkActor.Value = 1 Then
cboActor.Enabled = True
chkGenre.Value = False
chkItemCode.Value = False
Else
cboActor.Enabled = False
End If
End Sub
Private Sub chkFilterByCashier_Click()
If chkFilterByCashier.Value = 1 Then
cboCashier.Enabled = True
Else
cboCashier.Enabled = False
End If
End Sub
Private Sub chkFilterBy租阅者_Click()
If chkFilterBy租阅者.Value = 1 Then
Cbo租阅者.Enabled = True
Else
Cbo租阅者.Enabled = False
End If
End Sub
Private Sub chkGenre_Click()
If chkGenre.Value = 1 Then
cboGenre.Enabled = True
chkItemCode.Value = False
chkActor.Value = False
Else
cboGenre.Enabled = False
End If
End Sub
Private Sub chkItemCode_Click()
If chkItemCode.Value = 1 Then
cboItemCode.Enabled = True
chkGenre.Value = False
chkActor.Value = False
Else
cboItemCode.Enabled = False
End If
End Sub
Private Sub Cmdbjss_Click()
Dim db1 As Database
Dim rec1 As Recordset
Dim TDM As Variant
Dim loop1 As Long
Set db1 = OpenDatabase(App.Path & "\Transaction\Transaction.mdb", False, False, ";pwd=AdmiN")
Set rec1 = db1.OpenRecordset("Transaction", dbOpenTable)
rec1.MoveFirst
For loop1 = 1 To rec1.RecordCount
If rec1.Fields("InvoiceNumber") = FlexSales.TextMatrix(FlexSales.RowSel, 1) Then
If rec1.Fields("MembersName") = FlexSales.TextMatrix(FlexSales.RowSel, 4) Then
If Mid(rec1.Fields("Borrowed Items"), 13, 8) = FlexSales.TextMatrix(FlexSales.RowSel, 5) Then
If rec1.Fields("交易数量") = Val(FlexSales.TextMatrix(FlexSales.RowSel, 8)) Then
rec1.Edit
rec1.Fields("是否归还") = "已失损"
rec1.Update
rec1.Close
MsgBox "已经将 " & FlexSales.TextMatrix(FlexSales.RowSel, 4) & " 租借的 " & FlexSales.TextMatrix(FlexSales.RowSel, 5) & " 项目标记为失损！", , "更新成功！"
Exit Sub
End If
Else: rec1.MoveNext 'MsgBox "无法找到相关项目！", , "注意！"
End If
Else: rec1.MoveNext 'MsgBox "无法找到相关项目！", , "注意！"
End If
Else: rec1.MoveNext ' MsgBox "无法找到相关项目！", , "注意！"
End If
Next loop1
MsgBox "无法找到相关项目！", , "注意！"
End Sub
Private Sub cmdFlexSalesToExcel_Click()
If Trim(FlexSales.TextMatrix(1, 0)) = "" Then
FlexSales.SetFocus
Exit Sub
End If
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.CopyFlexDataToExcel(FlexSales)
MousePointer = vbDefault
End Sub
Private Sub cmdFlexToExcel_Click()
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.CopyFlexDataToExcel(FlexListOfItemsToBEReturnedToday)
MousePointer = vbDefault
FlexListOfItemsToBEReturnedToday.SetFocus
End Sub
Private Sub cmdGenerateReport_Click()
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
'START SQL
Dim mySQL As String
mySQL = "SELECT * FROM [Transaction] WHERE (Date >= #" & DTSalesStart.Value & "# AND Date <= #" & DTSalesEnd.Value & "#) ORDER BY Date"
If chkFilterByCashier.Value = 1 And Trim(cboCashier.Text) <> "" Then
mySQL = "SELECT * FROM [Transaction] WHERE Cashier = '" & cboCashier.Text & "' AND (Date >= #" & DTSalesStart.Value & "# AND Date <= #" & DTSalesEnd.Value & "#)ORDER BY Date"
End If
If chkFilterBy租阅者.Value = 1 And Trim(Cbo租阅者.Text) <> "" Then
mySQL = "SELECT * FROM [Transaction] WHERE MembersName = '" & Cbo租阅者.Text & "' AND (Date >= #" & DTSalesStart.Value & "# AND Date <= #" & DTSalesEnd.Value & "#)ORDER BY Date"
End If
'End SQL
Call vr_engine.Report_GetSalesDetailed(FlexSales, mySQL)
Call FlexSales_TotalSales
FlexSales.SetFocus
MousePointer = vbDefault
End Sub
Private Sub cmdGenerateStat_Click()
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Dim mySQL As String
' START SQL
mySQL = "SELECT DISTINCT 标题 FROM [CD TAPES TABLE] "
If chkGenre.Value = 1 Then
mySQL = "SELECT DISTINCT 标题 FROM [CD TAPES TABLE] WHERE 关键字 = '" & cboGenre.Text & "'"
End If
If chkItemCode.Value = 1 Then
mySQL = "SELECT 标题 FROM [CD TAPES TABLE] WHERE [Item Code] = '" & cboItemCode.Text & "'"
''MsgBox Trim(Mid(mySQL, 42, 11)) 'Detect [Item Code]
''MsgBox Trim(Mid(mySQL, 57, Len(mySQL) - 57)) 'Detect [Item Code] value
End If
If chkActor.Value = 1 Then
mySQL = "SELECT 标题 FROM [CD TAPES TABLE] WHERE 作者 = '" & vr_engine.ReplaceString(cboActor.Text, "'", "''") & "'"
End If
' END SQL
Call vr_engine.REPORT_GETMOVIESTAT(FlexMovie, DTPickerStart, DTPickerEnd, optDescending, mySQL)
FlexMovie.SetFocus
MousePointer = vbDefault
End Sub
Private Sub cmdPrint_Click()
'--------------------------------------------
If Trim(FlexMovie.TextMatrix(1, 0)) = "" Then
FlexMovie.SetFocus
Exit Sub
End If
'--------------------------------------------
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -