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: 69966 Skopiuj do schowka VBA i Access edytowanie danych w tabelach i kwerendach
Autor Wiadomość
jacek117
Świeżak


Wersja: Mac Office 365
Posty: 1
Wysłany: 27-01-2021, 11:00   VBA i Access edytowanie danych w tabelach i kwerendach

kiedy muszę dokonać zmiany danych w tabeli to korzystam ze schematu

Kod:
Dim baza As DAO.Database
Dim zrodlo As DAO.Recordset

Set baza=CurrentDb
Set zrodlo = baza.OpenRecordset("nazwa tabeli")
zrodlo.MoveFirst
zrodlo.Edit
zrodlo![jakies_pole]="jakaś nowa wartość"
zrodlo.Update
zrodlo.Close
set zrodlo=Nothing
set baza=Nothing


Problem pojawia się kiedy zamiast tabeli "nazwa tabeli" chciałbym edytować dane w kwerendzie. Czy ktoś może mi podrzucić kawałek kodu lub w inny sposób podpowiedzieć jak to zrobić w VBA. Z góry dziękuję.
ID posta: 399136 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3091 razy
Posty: 10242
Wysłany: 28-01-2021, 15:32   

Kwerendy są chyba nieedytowalne. Ale ja się na Acc nie znam.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 399253 Skopiuj do schowka
 
 
DwaNiedźwiedzie 
Excel Expert



Wersja: Win Office 2016
Pomógł: 278 razy
Posty: 686
Wysłany: 28-01-2021, 18:21   

Jak najbardziej są edytowalne i jak najbardziej z poziomu VBA :) Kilka lat temu napisałem makra eksportujące i importujące kwerendy i u mnie się to sprawdzało, ale na wszelki wypadek polecam działać na kopii bazy!

Najpierw robimy zrzut do pliku:
Kod:
Sub zrzuc_kwerendy_do_txt()
Dim hf As Integer: hf = FreeFile
Dim plik As String, gwiazdki As String, txt As String, k As Long
Dim kwerendy As QueryDefs, kwer As QueryDef

plik = CurrentProject.FullName & "_kwerendy.sql"

Open plik For Output As #hf
   
Set kwerendy = CurrentDb().QueryDefs

For Each kwer In kwerendy
   gwiazdki = "/* " & String(Len(kwer.Name) + 10, "*") & " */"
   
   txt = txt & vbCrLf & gwiazdki & vbCrLf
   txt = txt & "/* kwerenda: " & kwer.Name & " */" & vbCrLf
   txt = txt & gwiazdki & vbCrLf
   txt = txt & vbCrLf & kwer.SQL & vbCrLf
   
   k = k + 1
Next

Print #hf, txt
Close #hf

MsgBox "Zrzuciłem " & k & " kwerend do pliku:" & vbCrLf & vbCrLf & plik, vbInformation

End Sub


Po eksporcie otrzymujemy plik tekstowy z nagłówkami kwerend w poniższej postaci oraz samymi kwerendami:

/* ****************** */
/* kwerenda: L_02_Sel */
/* ****************** */

SELECT kol1, kol2
FROM Tabela1;


Następnie edytujemy kwerendę w notatniku i zmieniamy początek środkowej linii nagłówka na *-- kwerenda:

/* ****************** */
*-- kwerenda: L_02_Sel */
/* ****************** */

SELECT kol1, kol2
FROM Tabela2;


Teraz możemy zaczytać ją do accessa poniższym makrem:
Kod:
Sub popraw_kwerendy()
Dim hf As Integer: hf = FreeFile
Dim plik As String, Dzielnik As String, Dl_Dziel As Byte, Prefiks As String, i As Long, k As Long
Dim Zrodlo() As String, Kwerenda As QueryDef, Kwer_Nazwa As String, Kwer_SQL As String

'plik ze źródłami kwerend
plik = CurrentProject.FullName & "_kwerendy.sql"

If MsgBox("UWAGA: makro może zdrowo namieszać, chcesz kontynuować?" & vbCrLf & vbCrLf & "Wczytywany plik: " & vbCrLf & plik, vbCritical + vbOKCancel) = vbCancel Then Exit Sub

'oddziela kolejne kwerendy
Dzielnik = "/* "
Dl_Dziel = Len(Dzielnik)
'gwiazdka wskazuje na kwerendę do zmiany
Prefiks = "*-- kwerenda: "

Open plik For Input As #hf
    Zrodlo = Split(Input$(LOF(hf), #hf), vbNewLine)
Close #hf

For i = 0 To UBound(Zrodlo)
    'Debug.Print "wiersz"; i; ":"; zrodlo(i)
    If InStr(Zrodlo(i), Prefiks) = 1 Then
      Kwer_Nazwa = Replace(Zrodlo(i), Prefiks, "")
      Kwer_Nazwa = Trim(Replace(Kwer_Nazwa, "*/", ""))
     
      On Error Resume Next
      Set Kwerenda = Nothing
      Set Kwerenda = CurrentDb().QueryDefs(Kwer_Nazwa)
      On Error GoTo 0
     
      If Kwerenda Is Nothing Or Kwer_Nazwa = "" Then
         MsgBox "Błąd w linii " & i + 1 & ", błędna nazwa kwerendy!" & vbCrLf & "Operacja przerwana.", vbExclamation
         Exit Sub
      End If

      i = i + 2
      Kwer_SQL = ""
     
      Do While Left(Zrodlo(i), Dl_Dziel) <> Dzielnik
         i = i + 1
         If Not Left(Zrodlo(i), 3) = "/* " Then
            Kwer_SQL = Kwer_SQL & vbCrLf & Zrodlo(i)
         End If
      Loop
     
      If Kwer_SQL = "" Then
         MsgBox "Próba zaczytania pustego SQl do kwerendy " & vbCrLf & Kwer_Nazwa & vbCrLf & "Operacja przerwana.", vbExclamation
         Exit Sub
      Else
         Kwerenda.SQL = Kwer_SQL
         k = k + 1
      End If
    End If
Next

MsgBox "Makro zakończone, zaczytałem " & k & " kwerend.", vbInformation

End Sub
ID posta: 399264 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

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe