Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 18166 Skopiuj do schowka odwołać się względnie z Excela do bazy danych w Accesie
Autor Wiadomość
margerytka 
Exceloholic



Pomogła: 5 razy
Posty: 150
Wysłany: 24-09-2010, 15:05   odwołać się względnie z Excela do bazy danych w Accesie

Witajcie!

Mam w Excelu przestawną tabelę danych. Tabela została utworzona przez kreatora msquery. Dane zostały zassane z tabeli w bazie danych w Accesie. Dane w bazie się zmieniają, więc potrzebuję co jakiś czas odświeżyć tabelę przestawną.

Z automatu utworzyło mi się odwołanie bezwględne do bazy na dysku. Ponieważ przenoszę pliki między komputerami, utworzyłam je na pendriv'ie. Ale, kurcze, komp w domu przypisuje penowi inną literę dysku i znowu jestem w lesie.

Moje pytania:
1) Czy da się utworzyć odwołanie względne z tabeli przestawnej Excel do bazy danych Access? Powiedzmy do pliku o jakiejś nazwie w tym samym folderze?
2) A może mogę edytować odwołanie do bazy w istniejącej już tabeli przestawnej?

[ Dodano: 2010-09-24, 19:23 ]
Zmieniłam literę przypisaną do dysku w komputerze, ale to rozwiązanie, chociaż działa na chwilę obecną, to jak wchodzić do pokoju przez okno ;)
_________________
Pozdrawiam
Margerytka
ID posta: 96679 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Pomógł: 1749 razy
Posty: 2888
Wysłany: 27-09-2010, 09:30   

Nie znam się na tyle na Tabelach Przestawnych żeby powiedzieć "nie da się!" ale jeżeli Tabelę przestawną stworzylibyśmy za pomocą VBA to mogę coś podpowiedzieć :-)
Przykład tworzę w Office 2003. Wiem że Tabele Przestawne w E2007 trochu się pozmieniały więc jeżeli Twoje zadanie dotyczy tej właśnie wersji możliwe że trzeba bedzie jeszcze trochu czasu przy tym spędzić (w E2007 jeszcze takich manewrów nie próbowałem :-) ) ale najpierw muszę uzyskać aprobatę pomysłu ;-)

1. Zmienna litera dysku przenośnego
Zakładam że pewna część ścieżki jest stała tzn. wiesz że baza znajduje się na dysku przenośnym np: w katalogu Baza. Więc jej przykładowa ścieżka to E:\baza\baza.mdb.
Za pomocą Scripting.Drives, podając tę stałą część scieżki, a więc:
\baza\baza.mdb można ustalić ścieżkę do bazy.
Kod:
Function DateBasePath(strConstPathPart As String) As String
    Dim objFSO As Object ' Scripting.FileSystemObject
    Dim colDrives As Object 'Scripting.Drives
    Dim objDrive As Object 'Scripting.Drive
   
    If Left(strConstPathPart, 1) <> "\" Then strConstPathPart = "\" & strConstPathPart
   
    Const Removable = 1
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set colDrives = objFSO.Drives

    On Error Resume Next
    For Each objDrive In colDrives
        With objDrive
        'Debug.Print .DriveLetter
            If .DriveType = Removable And .IsReady Then
                If Dir(.DriveLetter & ":\" & strConstPathPart) <> vbNullString Then
                    DateBasePath = .DriveLetter & ":" & strConstPathPart
                    Exit For
                End If
            End If
        End With
    Next
    Set objFSO = Nothing
    Set colDrives = Nothing
End Function


2. Utworzenie tabeli przestawnej z danych z ACC

Tabelę przestawną można utworzyć na Recordsecie utworzonym obiektami ADODB.
Trzeba by więc:

1. Mając ścieżkę do bazy utworzyć obiekt połączenia i recordset. Jeżeli recordset nie będzie pusty to..
2. Sprawdzić czy istnieje już tabela przestawna (po nazwie) którą poprzedniu utworzyliśmy. Jeżeli istnieje to ją usunąć.
3. Utworzyć tabelę przestawną na Recordsecie
Kod:
Option Explicit

Const adOpenStatic = 3
Const adStateOpen = 1
Const adEditNone = 0
Const adUseClient = 3
Const adCmdText = 1
Const adModeRead = 1

Sub PivotNaADORecordset()
    On Error GoTo PivotNaADORecordset_Error

    Dim wks As Excel.Worksheet
    Dim objPivotCache As PivotCache, objPivTable As PivotTable
    Dim strPlikZDanymiFullName As String
   
    Dim objConnection As Object
    Dim objRecordset As Object

    Const strSQL As String = "SELECT * FROM tblTabela1;"
    Const strPivName As String = "pivMojaTabela"
   
    strPlikZDanymiFullName = DateBasePath("\Baza\baza.mdb")
    If Len(strPlikZDanymiFullName) = 0 Then
        MsgBox "Czy aby napewno pen z bazą został podpięty ??", vbExclamation
        Exit Sub
    End If
   
    Set objConnection = CreateObject("ADODB.Connection")
    With objConnection
        .CursorLocation = adUseClient
        .Mode = adModeRead
        .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & strPlikZDanymiFullName & ";"
        Set objRecordset = .Execute(strSQL, , adCmdText)
    End With
    If Not (objRecordset.BOF And objRecordset.EOF) Then
       
        Application.ScreenUpdating = False
       
        Set wks = ThisWorkbook.Worksheets("Arkusz1")
        On Error Resume Next
            Set objPivTable = wks.PivotTables(strPivName)
            If Not objPivTable Is Nothing Then
                objPivTable.PivotSelect "": Selection.Clear
            End If
            Set objPivTable = Nothing
        On Error GoTo PivotNaADORecordset_Error
       
        Set objPivotCache = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        Set objPivotCache.Recordset = objRecordset
        With objPivotCache
            .CreatePivotTable TableDestination:=wks.Range("A1"), _
                              TableName:=strPivName
        End With
       
        With wks.PivotTables(strPivName)
            .SmallGrid = False
            With .PivotFields("Data")
                .Orientation = xlRowField
                .Position = 1
            End With
            With .PivotFields("Typ")
                .Orientation = xlColumnField
                .Position = 1
            End With
            With .PivotFields("Ile")
                .Orientation = xlDataField
                .Position = 1
            End With
        End With
    End If
   
    ThisWorkbook.ShowPivotTableFieldList = False

PivotNaADORecordset_Exit:
    On Error Resume Next
   
    Application.ScreenUpdating = True
   
    Set wks = Nothing
    Set objPivotCache = Nothing
    Set objPivTable = Nothing
   
    CloseRSObject objRecordset
    CloseConObject objConnection
    Exit Sub

PivotNaADORecordset_Error:
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _
            Err.Description, vbExclamation, "VBAProject - PivNaADORec"
    Resume PivotNaADORecordset_Exit

End Sub

Public Sub CloseConObject(Cnn As Object)
    If Not (Cnn Is Nothing) Then
        If Cnn.State = adStateOpen Then Cnn.Close
        Set Cnn = Nothing
    End If
End Sub

Public Sub CloseRSObject(Rs As Object)
    If Not (Rs Is Nothing) Then
        With Rs
            If CBool(.State And adStateOpen) Then
                If .EditMode <> adEditNone Then .CancelUpdate
                .Close
            End If
        End With
        Set Rs = Nothing
    End If
End Sub


W załączniku:
plik: zeszyt1.xls z kodem (pod przyciskiem w Ark.Arkusz1)
katalog baza a w nim plik baza.mdb - cały ten katalog wrzuć na pen'a i przetestuj kod.

Ps: przeanalizuj kod a zobaczysz że nie musisz tworzyć recordsetu (źródło danych do Pivota) na całości danych z tabeli ACC. Recordset jest tworzony przez wykonanie zapytania SQL'owego. W tym przykładzie jest to proste: SELECT * FORM tblTabela1; ale mozna przecierz określić jakie kolumny mają być dostępne, można nadawać warunki choćby w klauzuli WHERE... to zmniejszy istotnie ilość danych do analizy. Oczywiście można to zrobić na etapie analizy danych w Tabeli przestawnej. Jednak pewien stan "normalny" np: grupowania czy filtrowania trzeba by zaprogramować w kodzie albo każdorazowo nakładać po "odświeżeniu" danych.
Przemyśl sprawę :-)

Pulpit.rar
Pobierz Plik ściągnięto 161 raz(y) 20.04 KB

_________________
Tomek



Moja Stronka
APoCoTenExcel
Ostatnia aktualizacja: 2015-09-04
ID posta: 96728 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum