Dialog Vybrat tabulku - VBA Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Kurimak
nováček
Příspěvky: 17
Registrován: leden 16
Pohlaví: Muž
Stav:
Offline

Dialog Vybrat tabulku - VBA

Příspěvekod Kurimak » 19 led 2018 13:09

Věděl by někdo, jak do makra v Excelu dostat dialogové okno Vybrat tabulku z Accessu - jak napsat pro jeho vyvolání kód.
Přes nahrávání maker se mi to nedaří.
Obrázek

Reklama
guest
Pohlaví: Nespecifikováno

Re: Dialog Vybrat tabulku - VBA

Příspěvekod guest » 19 led 2018 19:38

Dvě věci. Jestli se nepletu, tento dialog se objevuje v rámci importu dat z Accessu do Excelu. Je tedy součástí nějakého průvodce, kterému předchází dialog pro výběr souboru. Jak chcete skočit do nějakého kroku procesu z ničeho nic? Kromě toho jsem přesvědčen o tom, že dialog pro napojení nepotřebujete. Nebo skutečně musíte vybírat z dostupných tabulek?

Kurimak
nováček
Příspěvky: 17
Registrován: leden 16
Pohlaví: Muž
Stav:
Offline

Re: Dialog Vybrat tabulku - VBA

Příspěvekod Kurimak » 22 led 2018 08:40

Ano je to dialog v importu dat z Accessu do Excelu. Potřebuji vybírat různé tabulky. Zatím jsem to vyřešil tak, že název tabulky, kterou chci importovat, píšu do buňky na listu. Možnost určit název tabulky v průběhu makra by vše usnadnila.
Pokud by to bylo složité, spokojím se s tím, co už mám.

Kód makra uvádím dole:

  1. Private Sub ImportAccess_Click()
  2. Dim Cela_Cesta As String, Cesta As Variant, Cesta2 As String, F As String
  3. Dim Radek As Long
  4. Dim Database As Object
  5. Dim Rs As Object
  6. Dim Odkaz As Worksheet
  7. Dim Sloupec As Integer
  8. Dim Tabulka As String
  9. Dim Pripona As String, Znak As String, I As Integer, Poloha As Integer
  10. Dim Delka As Integer
  11.  
  12.  
  13. 'Spuštění dialogu pro výběr souboru a ověření výběru
  14. Cesta = Application _
  15.     .GetOpenFilename("Databáze Access (*.mdb), *.mdb,(*.accdb), *.accdb ")
  16. If Cesta = False Then
  17.     MsgBox "Nic neotevřeno.", vbInformation, "Informace uživateli"
  18.     Exit Sub
  19. End If
  20.  
  21.  
  22.  
  23. If Worksheets("Ovladac").Cells(2, 2).Value = "" Then
  24.     MsgBox "Není vyplněn název tabulky pro import", vbCritical, "Chyba!"
  25. Exit Sub
  26. End If
  27.  
  28. Tabulka = Trim(Worksheets("Ovladac").Cells(2, 2).Value)
  29. Pripona = Worksheets("Ovladac").Cells(4, 2).Value
  30.  
  31. Worksheets("Access").Cells.Delete
  32.  
  33. 'Definování umístění složky a jejího názvu
  34. Delka = Len(Cesta)
  35.  
  36. For I = Delka To 1 Step -1
  37. Znak = Mid(Cesta, I, 1)
  38. If Znak = "\" Then
  39.     Poloha = I
  40.     Exit For
  41.   End If
  42. Next I
  43.  
  44.  
  45. Cela_Cesta = Left(Cesta, Poloha) & Pripona
  46. Cesta2 = Left(Cesta, Poloha)
  47.  
  48.  
  49. Application.ScreenUpdating = False
  50.  
  51.  
  52. F = Dir(Cela_Cesta)
  53.  
  54. Radek = 2
  55.  
  56. 'Definování odkazu pro výběr dat
  57. Set Odkaz = Worksheets("Access")
  58.  
  59.  
  60.  
  61. 'Vytvoření objektové proměnné spustí Access na pozadí
  62. Dim app As New Access.Application
  63.  
  64.  
  65.  
  66. 'Otevření zdrojové databáze a vytvoření její objektové proměnné
  67. On Error GoTo Chyba2
  68. app.OpenCurrentDatabase Cesta2 & F
  69. Set Database = app.CurrentDb
  70. ' Vytvoření recordsetu
  71. On Error GoTo Chyba
  72. Set Rs = Database.OpenRecordset(Tabulka)
  73.  
  74. 'Zápis názvu polí
  75. For Sloupec = 0 To Rs.Fields.Count - 1
  76. Worksheets("Access").Range("A1").Offset(0, Sloupec).Value = _
  77.     Rs.Fields(Sloupec).Name
  78. Next
  79.  
  80. ' Zkopírování vybraných záznamů do sešitu
  81. Odkaz.Cells(Radek, 1).CopyFromRecordset Rs
  82. Rs.Close
  83. 'Přičítání řádků - určení prvního neposaného řádku
  84. Radek = Cells.CurrentRegion.Rows.Count + 1
  85. 'Uzavření aktuální databáze
  86. app.CloseCurrentDatabase
  87.  
  88.  
  89.  
  90. 'Procházení dalších souborů
  91.  
  92. Do
  93.     F = Dir
  94.     If F <> "" Then
  95.  
  96. 'Otevření zdrojové databáze a vytvoření její objektové proměnné
  97. On Error GoTo Chyba2
  98. app.OpenCurrentDatabase Cesta2 & F
  99. Set Database = app.CurrentDb
  100. ' Vytvoření recordsetu
  101. On Error GoTo Chyba
  102. Set Rs = Database.OpenRecordset(Tabulka)
  103.  
  104. 'Zkopírování vybraných záznamů do sešitu
  105. Odkaz.Cells(Radek, 1).CopyFromRecordset Rs
  106. Rs.Close
  107. 'Přičítání řádků - určení prvního nepopsaného řádku
  108. Radek = Cells.CurrentRegion.Rows.Count + 1
  109. If Radek >= 1048576 Then MsgBox "Sešit je již zaplněn.", vbCritical, "Chyba"
  110. 'Uzavření aktuální databáze
  111. app.CloseCurrentDatabase
  112.  
  113.     End If
  114. Loop While F <> ""
  115.  
  116. ' Ukončení Accessu
  117. app.Quit
  118.  
  119. Worksheets("Access").Activate
  120.  
  121. Application.ScreenUpdating = True
  122.  
  123. Exit Sub
  124. Chyba:
  125. MsgBox "Databáze: " & Cesta2 & F & " neobsahuje importovanou tabulku.", vbCritical, "Chyba!"
  126. Exit Sub
  127. Chyba2:
  128. MsgBox "Zřejmě byla vybrána databáze se špatným formátem.", vbCritical, "Chyba!"
  129. '
  130. 'Application.ScreenUpdating = True
  131. '
  132.  
  133.  
  134.  
  135. End Sub

guest
Pohlaví: Nespecifikováno

Re: Dialog Vybrat tabulku - VBA

Příspěvekod guest » 22 led 2018 11:05

Jukněte na Google... Získat seznam tabulek, ať už pod ADO, DAO, OLEDB není přeci problém. Výsledek hoďte do ComboBoxu a je to.

https://social.msdn.microsoft.com/Forum ... m=exceldev

Kurimak
nováček
Příspěvky: 17
Registrován: leden 16
Pohlaví: Muž
Stav:
Offline

Re: Dialog Vybrat tabulku - VBA  Vyřešeno

Příspěvekod Kurimak » 22 led 2018 14:12

Děkuji. Trochu jsem to upravil. Bylo třeba ještě přes Tools References zatrhnout knihovnu: Microsoft DAO Library 3.6.
Teď už si s tím dál nějak poradím:

Sub ListTables()
Dim DB As Database
Dim T As TableDef
Set DB = OpenDatabase(GetFileName())
For Each T In DB.TableDefs
MsgBox T.Name
Next
End Sub
Function GetFileName()

Dim sFname As Variant
Dim i As Long
Dim sname As String
sname = Application _
.GetOpenFilename("Databáze Access (*.mdb), *.mdb,(*.accdb), *.accdb ")
GetFileName = sname

End Function


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Který router vybrat?
    od HelFix » 23 říj 2023 20:09 » v Sítě - hardware
    11
    2098
    od HelFix Zobrazit poslední příspěvek
    06 lis 2023 21:33
  • jaký pc vybrat po x letech
    od nbnut » 20 srp 2023 00:33 » v Rady s výběrem hw a sestavením PC
    2
    768
    od Karrex Zobrazit poslední příspěvek
    20 srp 2023 08:43
  • Jaký zdroj mám vybrat k gpu?
    od qTomysw_ » 08 kvě 2023 01:23 » v Rady s výběrem hw a sestavením PC
    3
    733
    od pcmaker Zobrazit poslední příspěvek
    08 kvě 2023 11:12
  • Jaký zdroj vybrat?
    od lukes8 » 31 bře 2023 19:43 » v Rady s výběrem hw a sestavením PC
    2
    712
    od richchie Zobrazit poslední příspěvek
    31 bře 2023 21:28
  • Jaký router vybrat?
    od shippapi » 24 led 2024 11:21 » v Sítě - hardware
    4
    893
    od zeus Zobrazit poslední příspěvek
    24 led 2024 14:40

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů