Excel DataBase 外調數據庫生成透視表 - 奕閣 - 奕龍君

面對龐大的數據，想進一步要求工作人員不要過於依賴excel存儲數據，應該至少使用桌面數據庫，再利用Excel調用數據，這樣即安全又方便，於是做了示范給他們學習，可是發現似乎對於大多數辦公人員來說很複雜，教累學累，棄之，往後也沒有教他們學習。因為原始數據相對真實，還在使用中，為免麻煩，所以就放上圖片了，感興趣的可以看源代碼自己寫了測試。

Private Sub Workbook_Open()

Dim strCon As String, iPath As String, i As Integer, iStr As String, iFile As String    ‘定义变量
   ‘ On Error Resume Next
  
    iPath = ThisWorkbook.Path            ‘获取路径
    iFile = iPath + “\VIMTHData.dat”
  
  With ActiveWorkbook.Connections(“VIMTHDatabase ODBC”).ODBCConnection
        .BackgroundQuery = True
        .CommandText = Array( _
        “SELECT * FROM `” + iFile + “`.`房源总表`” _
        )
        .CommandType = xlCmdSql
        .Connection = Array(Array( _
        “ODBC;DSN=MS Access Database;DBQ=” + iFile + “;DefaultDir=” + iPath + “;” _
        ), Array( _
        “DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;” _
        ))
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = “”
        .SourceDataFile = “”
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With
    ‘ActiveWorkbook.Connections(“VIMTHDatabase ODBC”).Refresh
   tb = MsgBox(“Welcome to VIM ODBC DataBase!” + vbNewLine + vbNewLine + ”  Ver 0.1 2012 June ELooNG “, 0 + 64, “VIM”)
‘Application.Visible = True
End Sub

Sub StartData()
    Dim strCon As String, iPath As String, i As Integer, iStr As String, iFile As String    ‘定义变量
   ‘ On Error Resume Next
  
    iPath = ThisWorkbook.Path            ‘获取路径
    iFile = iPath + “\VIMTHData.dat”
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
        “ODBC;DSN=MS Access Database;DBQ=” + iFile + “;DefaultDir=” + iPath + “;” _
        ), Array( _
        “DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;” _
        )), Destination:=Range(“$A$1”)).QueryTable
        .CommandText = Array( _
        “SELECT * FROM `” + iFile + “`.`房源总表`” _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceConnectionFile = _
        .ListObject.DisplayName = “表_THDatabase_ODBC”
        .Refresh BackgroundQuery:=False
   End With
End Sub

Sub 按钮1_Click()

Dim PWD
PWD = CPSWD(“ViMeGa”)
Sheets(“Sheet1”).Visible = 2
Sheets(“Sheet1”).Unprotect Password:=PWD

‘ With Selection.ListObject.QueryTable

‘    End With

With ActiveWorkbook.Connections(“VIMTHDatabase ODBC”)
.ODBCConnection.BackgroundQuery = False
.Refresh
End With

mb = MsgBox(“VIM数据更新完成！”, 64 + 0)

‘ActiveWorkbook.Connections(“VIMTHDatabase ODBC”).Refresh
‘ActiveWorkbook.RefreshAll

Sheets(“Sheet1”).Protect AllowUsingPivotTables:=True, Password:=PWD

End Sub

Sub NewPivoTable()
‘
Dim SH, SN, PN
‘

Sheets.Add After:=Sheets(Sheets.Count)

SN = Sheets(Sheets.Count).Name
PN = “数据透视表” & SN
SN = SN + “!R3C2”

MsgBox (SN + PN)
        
    
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        “表_VIMTHData.mdb_房源总表”, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:=SN, TableName:=PN, DefaultVersion:= _
        xlPivotTableVersion12
   ‘ Sheets(“Sheet” + “SheetsCount”).Select

Cells(3, 1).Select
    
End Sub
Function CPSWD(PSWD)
Dim regEx, Match, Matches, NPWD

Set regEx = CreateObject(“VBSCRIPT.REGEXP”)
   regEx.Pattern = “([A-Za-z-0-9\W])”
   regEx.IgnoreCase = True
   regEx.Global = True
   PSWD = PSWD + Chr(255)
   PSWD = PSWD + Chr(16)
   Set Matches = regEx.Execute(PSWD)
   For Each Match In Matches
      NPWD = NPWD + Asc(Match)
   Next
   CPSWD = NPWD

End Function

Post Views: 637

發佈留言 取消回覆

發佈留言取消回覆