📄 frmwidgetorders.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmWidgetOrders
Caption = "Widget Orders"
ClientHeight = 3930
ClientLeft = 60
ClientTop = 345
ClientWidth = 8055
LinkTopic = "Form1"
ScaleHeight = 3930
ScaleWidth = 8055
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdRefresh
Caption = "&Refresh"
Height = 315
Left = 5520
TabIndex = 17
Top = 2520
Width = 1095
End
Begin VB.CommandButton cmdOk
Caption = "&Ok"
Height = 315
Left = 6780
TabIndex = 9
Top = 3060
Width = 1095
End
Begin VB.CommandButton cmdCancel
Caption = "&Cancel"
Height = 315
Left = 6780
TabIndex = 10
Top = 3480
Width = 1095
End
Begin VB.TextBox txtUnitPrice
Height = 285
Left = 5580
TabIndex = 8
Top = 3420
Width = 975
End
Begin VB.TextBox txtQuantity
Height = 285
Left = 4740
TabIndex = 7
Top = 3420
Width = 675
End
Begin VB.TextBox txtProductDesc
Height = 285
Left = 2340
TabIndex = 6
Top = 3420
Width = 2235
End
Begin VB.TextBox txtProductID
Height = 285
Left = 1320
TabIndex = 5
Top = 3420
Width = 855
End
Begin VB.TextBox txtOrderNum
Height = 285
Left = 300
TabIndex = 4
Top = 3420
Width = 855
End
Begin VB.CommandButton cmdView
Caption = "&View in Excel"
Height = 315
Left = 3840
TabIndex = 2
Top = 2520
Width = 1515
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Height = 315
Left = 180
TabIndex = 0
Top = 2520
Width = 1095
End
Begin VB.CommandButton cmdEdit
Caption = "&Edit"
Height = 315
Left = 1440
TabIndex = 1
Top = 2520
Width = 1095
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "&Close"
Default = -1 'True
Height = 315
Left = 6780
TabIndex = 3
Top = 2520
Width = 1095
End
Begin ComctlLib.ListView lstvWidgetOrders
Height = 2175
Left = 180
TabIndex = 11
Top = 180
Width = 7695
_ExtentX = 13573
_ExtentY = 3836
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
_Items = "frmWidgetOrders.frx":0000
End
Begin VB.Label lblUnitPrice
Caption = "Unit Price"
Height = 255
Left = 5580
TabIndex = 16
Top = 3180
Width = 975
End
Begin VB.Label lblQuantity
Caption = "Quantity"
Height = 255
Left = 4740
TabIndex = 15
Top = 3180
Width = 675
End
Begin VB.Label lblProductDesc
Caption = "Product Description"
Height = 255
Left = 2340
TabIndex = 14
Top = 3180
Width = 1515
End
Begin VB.Label lblProductID
Caption = "Product ID"
Height = 255
Left = 1320
TabIndex = 13
Top = 3180
Width = 855
End
Begin VB.Label lblOrderNum
Caption = "Order Num"
Height = 255
Left = 300
TabIndex = 12
Top = 3180
Width = 855
End
End
Attribute VB_Name = "frmWidgetOrders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' form level variables used to hold the database and recordset
Private db As Database
Private rs As Recordset
' form level constant values used to indicate the current state
Private Const ADD_RECORD = 0
Private Const EDIT_RECORD = 1
' form level variables used to save the current state, and selected
' list item
Private m_nState As Integer
Private m_oSelItem As ComctlLib.ListItem
' form level variables used to store the file path and sheet name
' of the Excel file used in the app
Private m_sFilePath As String
Private m_sSheetName As String
Private Sub Form_Activate()
' allow app to paint screen
DoEvents
' get paths and names of files used in app
m_sFilePath = DataPath & "\Chapter02\WidgetOrders.xls"
m_sSheetName = "Sheet1$"
' populate the list view control
PopulateListView
End Sub
Private Sub cmdAdd_Click()
' clear all the text boxes
txtOrderNum = ""
txtProductID = ""
txtProductDesc = ""
txtQuantity = ""
txtUnitPrice = ""
' show the bottom of the form and set the state to add so we know
' how to save the record later
ShowBottomForm
m_nState = ADD_RECORD
End Sub
Private Sub cmdEdit_Click()
' we cannot use indexs with Excel files, so we must transverse the
' recordset until the record matches the selected item, then populate
' the text boxes with the records values
With rs
.MoveFirst
While (.Fields("Order Number") <> m_oSelItem.Text)
.MoveNext
Wend
txtOrderNum = .Fields("Order Number")
txtProductID = .Fields("Product ID")
txtProductDesc = .Fields("Product Description")
txtQuantity = .Fields("Quantity")
txtUnitPrice = .Fields("Unit Price")
End With
' show the bottom of the form and set the state to editing so we know
' how to save the record later
ShowBottomForm
m_nState = EDIT_RECORD
End Sub
Private Sub cmdRefresh_Click()
' force a repopulation of the list view (use when the user has made
' changes in Excel to the file)
PopulateListView
End Sub
Private Sub cmdView_Click()
' set the recordset and database to nothing because Excel will not be
' able to successfuly open the file if not
Set rs = Nothing
Set db = Nothing
' open Excel with the file
Shell ExcelPath & " """ & m_sFilePath & """", vbNormalFocus
End Sub
Private Sub cmdClose_Click()
' always use Unload Me instead of End
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
' it is good practice to set all objects to nothing
Set m_oSelItem = Nothing
' this is equivalent to closing the recordset and the database
Set db = Nothing
Set rs = Nothing
End Sub
Private Sub cmdOk_Click()
' edit or add new is confirmed, save the values of the textboxes
' this would be a good place to code validation for each field
With rs
If (m_nState = ADD_RECORD) Then
.AddNew
Else
.Edit
End If
.Fields("Order Number") = txtOrderNum
.Fields("Product ID") = txtProductID
.Fields("Product Description") = txtProductDesc
.Fields("Quantity") = txtQuantity
.Fields("Unit Price") = txtUnitPrice
.Fields("Total Price") = txtUnitPrice * txtQuantity
.Update
End With
' repopulate the listview with the changes, then hide the bottom of
' the form
PopulateListView
HideBottomForm
End Sub
Private Sub cmdCancel_Click()
' edit or add new was canceled, hide the bottom of the form
HideBottomForm
End Sub
Private Sub lstvWidgetOrders_ItemClick(ByVal Item As ComctlLib.ListItem)
' set the selected item form variable to the selected item
Set m_oSelItem = Item
End Sub
Private Sub PopulateListView()
Dim oField As Field
Dim nFieldCount As Integer
Dim nFieldAlign As Integer
Dim nFieldWidth As Single
Dim oRecItem As ListItem
Dim sValFormat As String
' this might take a noticable amout of time, so before we do anything
' change the mousepointer to an hourglass and then hide the bottom of
' the form
Screen.MousePointer = vbHourglass
HideBottomForm
' open the database (this might already be open, however, if the user
' has just started the app or selected the 'View in Excel' button, then
' the database and recordset would be set to nothing
Set db = OpenDatabase(m_sFilePath, False, False, "Excel 8.0;HDR=YES;")
Set rs = db.OpenRecordset(m_sSheetName)
With lstvWidgetOrders
' clear the list view box in case this is a refresh of the records
.ListItems.Clear
.ColumnHeaders.Clear
' using the For Each statement as compared to the For To statement
' is technically faster, as well as being easier to understand and
' use
For Each oField In db.TableDefs(m_sSheetName).Fields
' align currency fields to the right, all others to the left
nFieldAlign = IIf((oField.Type = dbCurrency), _
vbRightJustify, _
vbLeftJustify)
' our product description field is text, and the values in this
' field are generally longer than their field name, so increase
' the width of the column
nFieldWidth = TextWidth(oField.Name) _
+ IIf(oField.Type = dbText, 500, 0)
' add the column with the correct settings
.ColumnHeaders.Add , , oField.Name, _
nFieldWidth, _
nFieldAlign
Next oField
End With
' add the records
With rs
.MoveFirst
While (Not .EOF)
' set the new list item with the first field in the record
Set oRecItem = lstvWidgetOrders.ListItems.Add(, , _
CStr(.Fields(0)))
' now add the rest of the fields as subitems of the list item
For nFieldCount = 1 To .Fields.Count - 1
' set a currency format for fields that are dbCurrency type
sValFormat = IIf(.Fields(nFieldCount).Type = dbCurrency, _
"$#,##0.00", _
"")
' set the subitem
oRecItem.SubItems(nFieldCount) = _
Format$("" & .Fields(nFieldCount), sValFormat)
Next nFieldCount
.MoveNext
Wend
End With
' by setting the last record item to the selected record item form
' variable, we can ensure ourselves that a record is selected for
' editing later
Set m_oSelItem = oRecItem
' remember to set object variables to nothing when you are done
Set oRecItem = Nothing
Set oRecItem = Nothing
Screen.MousePointer = vbDefault
End Sub
Private Sub ShowBottomForm()
' lengthen the height of the form and enable the proper controls
Me.Height = 4350
SetObjects False
End Sub
Private Sub HideBottomForm()
' shorten the height of the form and enable the proper controls
Me.Height = 3390
SetObjects True
End Sub
Private Sub SetObjects(StateIn As Boolean)
' set Enabled property for controls on top of form
cmdAdd.Enabled = StateIn
cmdEdit.Enabled = StateIn
cmdRefresh.Enabled = StateIn
cmdView.Enabled = StateIn
cmdClose.Enabled = StateIn
' set Enabled property for controls on bottom of form
txtOrderNum.Enabled = Not StateIn
txtProductID.Enabled = Not StateIn
txtProductDesc.Enabled = Not StateIn
txtQuantity.Enabled = Not StateIn
txtUnitPrice.Enabled = Not StateIn
cmdOk.Enabled = Not StateIn
cmdCancel.Enabled = Not StateIn
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -