北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |
Option Compare Database Option Explicit Private Sub Form_Load() Me.lstFld.RowSource = "" Me.lstSelFld.RowSource = "" Me.btnAddFld.Enabled = False Me.btnAddAllFld.Enabled = False Me.btnRemoveFld.Enabled = False Me.btnRemoveAllFld.Enabled = False Me.btnMoveUp.Enabled = False Me.btnMoveDown.Enabled = False Me.btnOK.Enabled = False End Sub Private Sub cboTbl_BeforeUpdate(Cancel As Integer) If Me.cboTbl.Text = "" Then Cancel = True Me.cboTbl.Dropdown End If End Sub Private Sub cboTbl_AfterUpdate() Dim intI As Integer Me.lstFld_B.RowSourceType = "Field List" Me.lstFld_B.RowSource = Me.cboTbl Me.lstFld.RowSource = "" For intI = 0 To Me.lstFld_B.ListCount - 1 Me.lstFld.AddItem Me.lstFld_B.ItemData(intI) Next Me.lstFld_B.RowSourceType = "Value List" Me.lstFld_B.RowSource = Me.lstFld.RowSource Me.lstSelFld.RowSource = "" Me.btnAddFld.Enabled = (Me.lstFld.RowSource <> "") Me.btnAddAllFld.Enabled = Me.btnAddFld.Enabled Me.btnRemoveFld.Enabled = False Me.btnRemoveAllFld.Enabled = False If Me.lstFld.RowSource <> "" Then Me.lstFld = Me.lstFld.ItemData(0) End Sub Private Sub btnAddFld_Click() Dim intIndex As Long If Me.lstSelFld.RowSource <> "" Then intIndex = Me.lstSelFld.ListIndex + 1 Me.lstSelFld.AddItem "'" & Me.lstFld & "'", intIndex Me.lstSelFld = Me.lstFld intIndex = Me.lstFld.ListIndex Me.lstFld.RemoveItem intIndex If intIndex > Me.lstFld.ListCount - 1 Then intIndex = Me.lstFld.ListCount - 1 If Me.lstFld.RowSource = "" Then Me.lstSelFld.SetFocus Me.btnAddFld.Enabled = False Me.btnAddAllFld.Enabled = False End If Me.lstFld = Me.lstFld.ItemData(intIndex) Me.btnRemoveFld.Enabled = True Me.btnRemoveAllFld.Enabled = True Me.btnMoveUp.Enabled = True Me.btnMoveDown.Enabled = True Me.btnOK.Enabled = True End Sub Private Sub lstFld_DblClick(Cancel As Integer) If Me.btnAddFld.Enabled Then Call btnAddFld_Click End Sub Private Sub btnAddAllFld_Click() Me.lstSelFld.RowSource = Me.lstFld_B.RowSource Me.lstSelFld = Me.lstSelFld.ItemData(0) Me.lstFld.RowSource = "" Me.lstSelFld.SetFocus Me.btnAddFld.Enabled = False Me.btnAddAllFld.Enabled = False Me.btnRemoveFld.Enabled = True Me.btnRemoveAllFld.Enabled = True Me.btnMoveUp.Enabled = True Me.btnMoveDown.Enabled = True Me.btnOK.Enabled = True End Sub Private Sub btnRemoveFld_Click() Dim intIndex As Long If Me.lstFld.RowSource <> "" Then intIndex = Me.lstFld.ListIndex + 1 Me.lstFld.AddItem "'" & Me.lstSelFld & "'", intIndex Me.lstFld = Me.lstSelFld intIndex = Me.lstSelFld.ListIndex Me.lstSelFld.RemoveItem intIndex If intIndex > Me.lstSelFld.ListCount - 1 Then intIndex = Me.lstSelFld.ListCount - 1 If Me.lstSelFld.RowSource = "" Then Me.lstFld.SetFocus Me.btnRemoveFld.Enabled = False Me.btnRemoveAllFld.Enabled = False Me.btnMoveUp.Enabled = False Me.btnMoveDown.Enabled = False End If Me.lstSelFld = Me.lstSelFld.ItemData(intIndex) Me.btnAddFld.Enabled = True Me.btnAddAllFld.Enabled = True If Me.lstSelFld.RowSource = "" Then Me.btnOK.Enabled = False End Sub Private Sub btnRemoveAllFld_Click() Me.lstFld.RowSource = Me.lstFld_B.RowSource Me.lstFld = Me.lstFld.ItemData(0) Me.lstSelFld.RowSource = "" Me.lstFld.SetFocus Me.btnAddFld.Enabled = True Me.btnAddAllFld.Enabled = True Me.btnRemoveFld.Enabled = False Me.btnRemoveAllFld.Enabled = False Me.btnMoveUp.Enabled = False Me.btnMoveDown.Enabled = False Me.btnOK.Enabled = False End Sub Private Sub lstSelFld_DblClick(Cancel As Integer) If Me.btnRemoveFld.Enabled Then Call btnRemoveFld_Click End Sub Private Sub btnMoveUp_Click() Dim strItem As String Dim intIndex As Integer If Me.lstSelFld.RowSource <> "" Then strItem = Me.lstSelFld intIndex = Me.lstSelFld.ListIndex Me.lstSelFld.RemoveItem intIndex If intIndex = 0 Then intIndex = Me.lstSelFld.ListCount Else intIndex = intIndex - 1 End If Me.lstSelFld.AddItem strItem, intIndex End If End Sub Private Sub btnMoveDown_Click() Dim strItem As String Dim intIndex As Integer If Me.lstSelFld.RowSource <> "" Then strItem = Me.lstSelFld intIndex = Me.lstSelFld.ListIndex Me.lstSelFld.RemoveItem intIndex If intIndex = Me.lstSelFld.ListCount Then intIndex = 0 Else intIndex = intIndex + 1 End If Me.lstSelFld.AddItem strItem, intIndex End If End Sub Private Sub btnOK_Click() On Error GoTo Err_btnOK_Click Dim intI As Integer Dim strSQL As String Dim strName As String strName = "查询结果" If Me.lstSelFld.RowSource <> "" Then For intI = 0 To Me.lstSelFld.ListCount - 1 strSQL = strSQL & ", [" & Me.lstSelFld.ItemData(intI) & "]" Next strSQL = "SELECT " & Mid(strSQL, 3) & "," & "sum(数量) AS 合计数量,sum(原值) AS 总额" & " FROM [" & Me.cboTbl & "]" & " Group BY " & Mid(strSQL, 3) 'strSQL = "SELECT " & Mid(strSQL, 3) & " FROM [" & Me.strWhere & "]" & " Group BY " & Mid(strSQL, 3) CurrentDb.CreateQueryDef strName, strSQL DoCmd.OutputTo acOutputQuery, strName, acFormatXLS, , True DoCmd.DeleteObject acQuery, strName End If Exit_btnOK_Click: Exit Sub Err_btnOK_Click: Select Case Err Case 3012 DoCmd.DeleteObject acQuery, strName Resume Case 2501 Resume Next Case Else MsgBox Err.Description, vbCritical Resume Exit_btnOK_Click End Select End Sub