(VBA学习小结)用access+excel建立完善的数据透视报表的一点心得

时　间:2011-12-24 12:28:44
作　者:何必见戴   ID：13894  城市：厦门
摘　要:access的数据透视表功能烂透了~难看又难用.如何把现有数据导出到excel,然后让excel自动生成预想的数据透视表报表呢,一些个人心得分享一下.

正　文:

access的数据透视表功能烂透了~难看又难用.如何把现有数据导出到excel,然后让excel自动生成预想的数据透视表报表呢,一些个人心得分享一下.

1、首先啦，先在某一个文件夹建立一个excel模板文件，比如D盘下建立“数据分析.xls”.开启"数据透视表"向导,在数据源中设定源为sheet1的某个列表,然后把数据透视表放到其他工作表中,比如sheet2.这样一个简单的透视表就生成了,随后删除sheet1!!.这步很重要.这样数据源就断开了,在sheet2的Worksheet_Activate事件中写入代码:

Private Sub Worksheet_Activate()
ActiveSheet.PivotTables("数据透视表3").PivotCache.Refresh
End Sub

当然也可以设定一些诸如调整格式之类的代码,这个可以通过最简单的录制宏来实现.

2、access中，假定你要汇总的数据源所在的子窗体为 conSubFormName。那么建立一个按钮，在其单击事件中写入如下代码：

Private Sub Command1_Click()

    Dim strPathName As String           '输出文件路径名

'当前是新记录则提示并退出
    If Me.NewRecord Then
        MsgBox "当前没有数据可导出！", vbExclamation, "提示"
        Exit Sub
    End If

    '通过文件对话框取得另存为文件名
    With FileDialog(2)    'msoFileDialogSaveAs
        .InitialFileName = "汇总数据.xls"
        If .Show Then strPathName = .SelectedItems(1)
    End With
    '对话框被取消则退出过程
    If strPathName = "" Then
        Exit Sub
    End If
    '如果文件名后没有.xls扩展名则加上
    If Not strPathName Like "*.xls" Then strPathName = strPathName & ".xls"
    '如果文件已存在，先删除已有文件
    If Dir(strPathName) <> "" Then Kill strPathName

    FileCopy "d:\数据分析.xls", strPathName
    DoCmd.RunSQL "Select * INTO [Sheet1] IN '" & strPathName & " '[EXCEL 8.0;] FROM  " & "(" & Me.Controls(conSubFormName).Form.RecordSource & ")"

    If MsgBox("是否要打开导出后的excel", vbOKCancel, "提示") = vbOK Then
        Call Shell("explorer.exe " & strPathName, vbNormalFocus)
    End If

End Sub

如此单击此按钮后,便会在你指定的路径生成含有这个数据源的excel文件,同时因为在新文件上进行了建立了sheet1并给予数值,那么原来的excel表中的数据透视表也就重新获得了数据源.在点击sheet2时会auto refresh.

至此,一个简单的示例就出来了,思路如此,可扩展的vba宏还很多,可以自由发挥.access在有所限制的时候,多想想它和其他office套件的结合,是可以事半功倍的统计分析当前数据的效果.