' Listing 12.1. Kod procedury obsugi zdarzenia, ktra utrzymuje synchronizacj wartoci 
' pola tekstowego i przycisku pokrta

Private Sub TextBox1_Change()
    SpinButton1.Value = TextBox1.Value
End Sub

Private Sub SpinButton1_Change()
    TextBox1.Value = SpinButton1.Value
End Sub

' Listing 12.2. Procedura obsugi zdarzenia Initialize, ktra konfiguruje kontrolk TabStrip

Private Sub UserForm_Initialize()
       
        Modyfikacja istniejcych kart
       
   With TabStrip1
       .Tabs(0).Caption = Oddzia I
       .Tabs(1).Caption = Oddzia II
                 
                  Dodanie nowej karty
                 
       .Tabs.Add Oddzia III
   End With
       
        Wprowadzenie pocztkowych danych dla Oddziau I
       
   With Worksheets(Budet 2007)
       txtSales = .[B2]
       txtExpenses = .[B12]
       txtGrossProfit = .[B13]
   End With
End Sub

' Listing 12.3. Procedura obsugi zdarzenia Change, ktra modyfikuje kontrolki w obrbie 
' obiektu TabStrip kadorazowo po uaktywnieniu przez uytkownika innej karty

Private Sub TabStrip1_Change()
        With Worksheets(Budet 2007)
            Select Case TabStrip1.Value
                Case 0
                                      
                                       Wprowadzenie danych dla Oddziau I
                                      
                txtSales = .[B2]
                txtExpenses = .[B12]
                txtGrossProfit = .[B13]
                Case 1
                                      
                                       Wprowadzenie danych dla Oddziau II
                                      
                txtSales = .[C2]
                txtExpenses = .[C12]
                txtGrossProfit = .[C13]
                Case 2
                                       
                                        Wprowadzenie danych dla Oddziau III
                                       
                txtSales = .[D2]
                txtExpenses = .[D12]
                txtGrossProfit = .[D13]
            End Select
        End With
End Sub

' Listing 12.4. Procedura przetwarzajca niestandardowy formularz ConvertCase

Private Sub cmdOK_Click()
    Dim c As Range
    For Each c In Selection
        If optProper.Value = True Then
           c.Value = StrConv(c, vbProperCase)
        ElseIf optUpper.Value = True Then
           c.Value = StrConv(c, vbUpperCase)
        ElseIf optLower.Value = True Then
           c.Value = StrConv(c, vbLowerCase)
        End If
    Next c
    Unload Me
End Sub


' Listing 12.5. Procedura wywietlajca tekst na pasku stanu Accessa
'
Sub StatusBarText()
    Dim frm As Form
    Dim strStatus As String
    Dim ctrlCount As Integer
    Dim i As Integer
    Dim start As Long
    '
    ' Otwarcie formularza zamwie
    '
    DoCmd.OpenForm "Startup", acDesign
    Set frm = Forms!Startup
    '
    ' Uzyskanie licznika sterujcego
    '
    ctrlCount = frm.Controls.Count
    '
    ' Przetworzenie kontrolek przez ptl
    '
    For i = 0 To ctrlCount - 1
        '
        ' Aktualizacja tekstu na pasku stanu
        '
        strStatus = "Kontrolka " & i + 1 & " z " & ctrlCount
        SysCmd acSysCmdSetStatus, strStatus
        '
        ' Okrelenie psekundowego opnienia
        '
        start = Timer
        Do While Timer < (start + 0.5)
            DoEvents
        Loop
    Next i
    '
    ' Wyczyszczenie paska stanu
    '
    SysCmd acSysCmdClearStatus
End Sub

' Listing 12.6. Procedura wywietlajca wskanik postpu na pasku stanu Accessa
'
Sub StatusBarProgressMeter()
    Dim frm As Form
    Dim ctrlCount As Integer
    Dim i As Integer
    Dim start As Long
    '
    ' Otwarcie formularza zamwie
    '
    DoCmd.OpenForm "Startup", acDesign
    Set frm = Forms!Startup
    '
    ' Uzyskanie licznika sterujcego
    '
    ctrlCount = frm.Controls.Count
    '
    ' Inicjalizacja wskanika postpu
    '
    SysCmd acSysCmdInitMeter, "Ptla sterujca:", ctrlCount
    '
    ' Przetworzenie kontrolek przez ptl
    '
    For i = 0 To ctrlCount - 1
        '
        ' Aktualizacja wskanika postpu
        '
        SysCmd acSysCmdUpdateMeter, i + 1
        '
        ' Okrelenie psekundowego opnienia
        '
        start = Timer
        Do While Timer < (start + 0.5)
            DoEvents
        Loop
    Next i
    '
    ' Wyczyszczenie paska stanu
    '
    SysCmd acSysCmdRemoveMeter
End Sub

