pisałem całość dzisiaj więc może do końca nie przetestowałem i stąd skąpe komentarze
szybki kontakt na e-mail
Jeżeli wyda Ci się za trudne i masz mało czasu do najwyżej poeksperymentuj i nie analizuj całości
Najtrudniejszym problemem jest ustawienie : wskażnika rekordu "IdRekordBiezacy" i znacznika statusu rekordu "RekordNowy" po każdej operacji odczytu, zapisu, dodaniu, usunięcia ( mogłem na szybko coś pokręcić )
w typowych bazach danych rekord jest udostępniany przez tzw bufor
jeżeli są to dane istniejącego rekordu to:
- IdRekordu = zapamiętana jest wartośc , np. jego numer lub wskaźnik
- Bufor = dane przechowywuje się w nim , bufor jest kopią danych rekordu
dla nowego rekordu
- IdRekordu = jego wartość wskazuje pierwszy wolny rekord (lub wskaźnik) lub 0 (jeżeli rekordy liczymy od 1) lub datakowy wskaźnik tu : RekordNowy
- Bufor = dane są wyzerowane lub wypełnione wartościami inicjującymi ( initial values )
Zalety
- dane w bazie są zmieniane tylko w wyniku zadziałania procedury zapisu
- wszystkie obiekty , procedury i funkcje zawsze ( nawet po zmianie rekordu ) odwołują się do tej samej reprezentacji rekordu bazy danych
- prównanie pól bufora i rekordu bazy danych (IdRekordu ) lub bufora i wartości inicjującyh ( nowy rekord ) umożliwią sprawdzenie czy i które pola zostały
zmienione
W naszym przypadku zastosowanie bufora umożliwi kolosalne uproszczenie przekazywania danych z i do TextBoxów przy użyciu jednorazowego zdefiniowania
ich właściowści ControlSource do komórek Bufor'u
Aktualny wskażnik rekordu wg powyżej opisanych reguł umożliwi zmianę danych w istniejącym rekordzie lub dodanie rekordu
funkcje :
F_ZpiszBfuorDoBazy()
' używa zmiennej RekordNowy
której wartość =True ustalana jest przez funkcję dodawania rekordu
'lub = False po zaniechaniu zapisu nowego rekordu i odczycie istniejącego
'lub =False po zapisie nowego rekordu
'lub używa IdRekordBiezacy , który był ustawiony przy ostatnim odczycie lub zapisie z/do bazy danych
lub odczytanie danych z rekordu
F_OdczytBazuDoBufora(IdRekordu)
brak IdRekordu - używa IdRekordBiezacy , który był ustawiony przy ostatnim odczycie lub zapisie z/do bazy danych
inny IdRekordu : w zakresie 1 do wartości funkcji F_RekordowIle() = ilość rekordów w bazie
powyższe funkcje zmieniają odpowiednio wartość zmiennej podającej wskazanie do bieżącego rekordu IdRekordBiezacy
'w nowym zeszycie
'-utworzyć Formularz "UserForm1"
'utworzyć na nim pola tekstowe "TextBox1", "TextBox2", "TextBox10"
'utworzyć na nim przyciski CommandButton "Następny", "Poprzedni", Dodaj", "Usuń"
' utworzyć etykietę Label "RekordLabel"
'wkleić załączony kod formularza ****************************
'utworzyć moduł kodu
'wkleić załączony kod modułu ************************
'uruchomić procedure TestBazy
' w czasie pierwszego uruchomienia zostaną dodane arkusze Danych "Baza1Dane" i Bufora "Baza1Bufor"
'kod formularza UserForm1 '**********************************************************
Private IdRekordBiezacy As Integer
Private RekordNowy As Boolean 'wskażnik dodawania rekordu
Private DaneArk As Worksheet, BuforArk As Worksheet
'adres zakresu Bufora, Wzorca formatu i danych nowych, każdego rekordu danych
'względem pierwszej komórki Bufora,Wzorca,każdego rekordu
Private RekordAdresStr As String
' wypełnić odpowiednio do stanu faktycznego
Const ArkuszDanychNazwa = "Baza1Dane", ArkuszBuforaNazwa = "Baza1Bufor"
' numer wiersza z buforem
Const BuforWiersz = 1
'z tego wiersza będą pobierane formaty komórek dla wiersza bufora i rekordu bazy
'i\lub wartości dla bufora nowego rekordu
'w tych komórkach mogą być formuły np. data bieżąca =DZIŚ()
'uwaga wczytanie daty do TextBoxa może być w formacie amerykańskim ! ale można wpisać w polskim i zapisze w arkuszu dobrze
Const BuforInicjującyWiersz = 2
'BARDZO WAŻNE wg stanu faktycznego wpisać TextBox'y w kolejności odpowiadającej kolumnom w Obszarze danych
Private TBxArr
Private ilePol As Integer
Public Sub BazaInit()
Dim TBxName
'BARDZO WAŻNE wg stanu faktycznego wpisać w kolejności odpowiadającej kolumnom w Obszarze danych
TBxArr = Array("TextBox1", "TextBox2", "TextBox10")
On Error Resume Next
Set DaneArk = ThisWorkbook.Worksheets(ArkuszDanychNazwa)
On Error GoTo 0
'automatyczne założenie arkusza BAZY
If DaneArk Is Nothing Then
' If MsgBox("brak arkusza danych bazy " & vbCr & "założyć ?", vbOKCancel + vbDefaultButton2 + vbCritical, "test bazy danych") <> vbOK Then
' End
' End If
Set DaneArk = ThisWorkbook.Worksheets.Add
DaneArk.Name = ArkuszDanychNazwa
End If
On Error Resume Next
Set BuforArk = ThisWorkbook.Worksheets(ArkuszBuforaNazwa)
On Error GoTo 0
'automatyczne założenie arkusza BUFORA
If BuforArk Is Nothing Then
' If MsgBox("brak arkusza bufora " & vbCr & "założyć ?", vbOKCancel + vbDefaultButton2 + vbCritical, "test bazy danych") <> vbOK Then
' End
' End If
Set BuforArk = ThisWorkbook.Worksheets.Add
BuforArk.Name = ArkuszBuforaNazwa
End If
ilePol = 0
For Each TBxName In TBxArr
ilePol = ilePol + 1
With Me.Controls(TBxName)
.ControlSource = ""
.ControlSource = BuforArk.Cells(BuforWiersz, ilePol).Address(rowabsolute:=False, columnabsolute:=False, external:=True)
End With
Next
RekordAdresStr = BuforArk.Cells(BuforWiersz, 1).Resize(, ilePol).Address(rowabsolute:=False, columnabsolute:=False)
If F_RekordowIle < 1 Then
UtworzNowyRekord
Else
F_OdczytBazyDoBufora 1
End If
PrzelaczTylkoNowy RekordNowy
End Sub
Private Function UsunRekord()
Dim IdRekordu
If RekordNowy Then Exit Function
If IdRekordBiezacy > 0 And IdRekordBiezacy <= F_RekordowIle Then
DaneArk.Rows(IdRekordBiezacy).Delete
IdRekordu = F_RekordowIle
If IdRekordu < 1 Then
UtworzNowyRekord
IdRekordBiezacy = 0
ElseIf IdRekordBiezacy <= IdRekordu Then
IdRekordu = IdRekordBiezacy
F_OdczytBazyDoBufora IdRekordu
Else
F_OdczytBazyDoBufora IdRekordu
End If
End If
End Function
Function UtworzNowyRekord()
RekordNowy = True
BuforArk.Cells(BuforInicjującyWiersz, 1).Range(RekordAdresStr).Copy
BuforArk.Cells(BuforWiersz, 1).Range(RekordAdresStr).PasteSpecial xlPasteFormats
BuforArk.Cells(BuforWiersz, 1).Range(RekordAdresStr).PasteSpecial xlPasteValues
On Error Resume Next
Me.RekordLabel.Caption = "NOWY/" & F_RekordowIle
On Error GoTo 0
End Function
Function F_OdczytBazyDoBufora(Optional ByVal IdRekordu) As Integer
If IsMissing(IdRekordu) Then IdRekordu = IdRekordBiezacy
If IdRekordu < 1 Or IdRekordu > F_RekordowIle Then
Exit Function
End If
BuforArk.Cells(BuforInicjującyWiersz, 1).Range(RekordAdresStr).Copy
BuforArk.Cells(BuforWiersz, 1).Range(RekordAdresStr).PasteSpecial xlPasteFormats
DaneArk.Cells(IdRekordu, 1).Range(RekordAdresStr).Copy
BuforArk.Cells(BuforWiersz, 1).Range(RekordAdresStr).PasteSpecial xlPasteValues
F_OdczytBazyDoBufora = IdRekordu
SetRekordSayBiezacy IdRekordu
RekordNowy = False
End Function
Private Function F_ZpiszBfuorDoBazy()
Dim IdRekordu As Integer
If RekordNowy Then
IdRekordu = F_RekordowIle + 1
ElseIf IdRekordBiezacy < 1 Or IdRekordBiezacy > F_RekordowIle Then
Exit Function
Else
IdRekordu = IdRekordBiezacy
End If
BuforArk.Cells(BuforInicjującyWiersz, 1).Range(RekordAdresStr).Copy
DaneArk.Cells(IdRekordu, 1).Range(RekordAdresStr).PasteSpecial xlPasteFormats
BuforArk.Cells(BuforWiersz, 1).Range(RekordAdresStr).Copy
DaneArk.Cells(IdRekordu, 1).Range(RekordAdresStr).PasteSpecial xlPasteValues
F_ZpiszBfuorDoBazy = IdRekordu
SetRekordSayBiezacy IdRekordu
RekordNowy = False
End Function
Private Function F_RekordowIle() As Integer
'wyszukanie ostatniego wiersza z danymi , jeżeli arkusz pusty będzie 0
With DaneArk.Cells
On Error Resume Next
F_RekordowIle = .Find("*", .Cells(.Rows.Count, .Columns.Count), xlValues, xlWhole, xlByRows, xlPrevious).Row
On Error GoTo 0
End With
End Function
Function SetRekordSayBiezacy(ByVal IdRekordu)
'jeżeli założona zostanie etykieta RekordLabel w niej będzie wyświetlana buchalteria rekordów
IdRekordBiezacy = IdRekordu
On Error Resume Next
Me.RekordLabel.Caption = IdRekordBiezacy & "/" & F_RekordowIle
On Error GoTo 0
End Function
Private Sub PrzelaczTylkoNowy(IsNowy As Boolean)
If Not IsNowy Then
Me.Następny.Enabled = True
Me.Poprzedni.Enabled = True
Me.Dodaj.Caption = "Dodaj"
Me.Usuń.Caption = "Usuń"
Else
Me.Następny.Enabled = False
Me.Poprzedni.Enabled = False
Me.Dodaj.Caption = "Zapisz nowy"
Me.Usuń.Caption = "Anuluj nowy"
End If
End Sub
Private Sub Dodaj_Click()
If RekordNowy Then
F_ZpiszBfuorDoBazy
Else
F_ZpiszBfuorDoBazy
UtworzNowyRekord
End If
PrzelaczTylkoNowy RekordNowy
End Sub
Private Sub Następny_Click()
Dim IdRekordu
IdRekordu = IdRekordBiezacy + 1
F_ZpiszBfuorDoBazy
If IdRekordu > 0 And IdRekordu <= F_RekordowIle Then
F_OdczytBazyDoBufora IdRekordu
End If
End Sub
Private Sub Poprzedni_Click()
Dim IdRekordu
IdRekordu = IdRekordBiezacy - 1
F_ZpiszBfuorDoBazy
If IdRekordu > 0 Then
F_OdczytBazyDoBufora IdRekordu
End If
End Sub
Private Sub Usuń_Click()
If RekordNowy Then
'skasuje znacznik nowy
F_OdczytBazyDoBufora IdRekordBiezacy
Else
UsunRekord
End If
PrzelaczTylkoNowy RekordNowy
End Sub
'kod modułu '**********************************************************
Sub testBazy()
UserForm1.BazaInit
UserForm1.Show
End Sub |