Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

大神们,怎么对需要的字段进行汇总或者明细导出,

马生  发表于:2018-05-25 17:10:14  
复制

就是在这个界面的下方加上汇总或者明细的按钮,然后导出汇总的或者明细的。就是在通用导入导出是上最后的语句加了个group by。不过导出的表格需要另存为,而且没有格式。也想将这个导出功能的数据源是我查询后的字窗体数据。而不是数据库!(原版是红尘老师的通用1.1版里面的导入导出)
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

 

Top
马生 发表于:2018-05-30 12:01:38
怎么将该表的数据源设置为子窗体

总记录:1篇  页次:1/1 9 1 :