Option Compare Database
Option Explicit
Private Const LABEL_PREFIX As String = "Etykieta"
Public Function wstaw()
'funkcja sprawdza na wejściu czy jest "paid" wypłęnione. jeśli nie zwraca komnikat i zmienia kolor
If Len(Me.paid.Value & vbNullString) = 0 Then
Me.paid.BackColor = RGB(255, 255, 0)
MsgBox "Miejsce nie opłacone"
Else
Me.paid.BackColor = RGB(255, 255, 255)
End If
End Function
Private Sub bntFilter_Click()
DoCmd.OpenForm "Filtruj", WindowMode:=acDialog
End Sub
Private Sub btnDelete_Click()
Me.MAPA = Null 'ImagePath
' hide image control and show 'No Image' label
Me.lblNoImage.Visible = True
Me.ctrlImage.Visible = False
End Sub
Private Sub btnPrint_Click()
'On Error GoTo ErrorHandler
DoCmd.OpenForm "Drukuj", acNormal
End Sub
Private Sub btnRight_Click()
DoCmd.GoToRecord , , acNext
End Sub
Private Sub btnService_Click()
DoCmd.OpenForm "OknoKomunikatu", WindowMode:=acDialog
End Sub
Public Function ZmienKolor()
Dim con As Control
For Each con In Me.Controls
If TypeOf con Is Label Then
con.BackStyle = 0
End If
Next con
'*****************************
'odwołanie do formualrza Drukuj i jego zestwau kontrolek
'aby odwołać się do ctl muszę niejawnie otworzyć formualarz
DoCmd.OpenForm "Drukuj", acDesign, , , , acHidden
Dim ctlr As Control
'zmienia kolor 0 w formularz Drukuj - referes to another form and changes the colour
For Each ctlr In Forms!Drukuj.Controls
If TypeOf ctlr Is Label Then
ctlr.BackStyle = 0
End If
Next ctlr
End Function
Private Function LblClickGoToRecord(idx As Integer) As Boolean
DoCmd.GoToRecord , , acGoTo, idx
LblClickGoToRecord = (Err = 0)
End Function
Public Function wybor()
End Function
Private Sub Etykieta25_Click()
'DoCmd.GoToRecord , , acGoTo, 25
End Sub
Private Sub Etykieta24_Click()
'DoCmd.GoToRecord , , acGoTo, 24
End Sub
Private Sub Form_Current()
Dim con As Variant
If Not IsNull(Me.MAPA) Then 'było ImagePath
' show image control and hide 'No Image' label
Me.lblNoImage.Visible = False
Me.ctrlImage.Visible = True
Else
' hide image control and show 'No Image' label
Me.lblNoImage.Visible = True
Me.ctrlImage.Visible = False
End If
'hiding all colours
Call wstaw
End Sub
Private Sub Form_Load()
DoCmd.Maximize
Dim lbl As Access.Control
For Each lbl In Me.Controls
' If ButtonOneClick Then
If lbl.ControlType = acLabel Then ' And LEFT(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
' Me.Controls("Etykieta" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1)).Value
lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
End If
'End If
Next
End Sub
Private Function LabelClick(idx As Integer) As Boolean
Call SetLabelColour
Call SetLabelColour(idx, vbYellow)
LabelClick = (Err = 0)
End Function
Private Function SetLabelColour(Optional idx As Integer = -1, Optional lColour As Long = -1) As Boolean
Dim lbl As Access.Control
If idx >= 0 Then
If lColour >= 0 Then
If Not Me("Etykieta" & idx).BackColor = lColour Then Me("Etykieta" & idx).BackColor = lColour
If Not Me("Etykieta" & idx).BackStyle = 1 Then Me("Etykieta" & idx).BackStyle = 1
Else
If Not Me("Etykieta" & idx).BackStyle = 0 Then Me("Etykieta" & idx).BackStyle = 0
End If
Call LblClickGoToRecord(idx)
Else
For Each lbl In Me.Controls
If lbl.ControlType = acLabel Then
If lColour >= 0 Then
If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
Else
If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
End If
End If
Next
End If
SetLabelColour = (Err = 0)
End Function
Private Sub Etykieta1_Click()
'DoCmd.GoToRecord , , acGoTo, 1
'Me.Etykieta1.BackStyle = 1
' Me.Etykieta1.BackColor = RGB(255, 255, 2) 'żółty
'Forms!Drukuj.Controls("Etykieta1").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)
End Sub
Private Sub Etykieta2_Click()
' DoCmd.GoToRecord , , acGoTo, 2
'Me.Etykieta2.BackStyle = 1
'Me.Etykieta2.BackColor = RGB(255, 255, 2) 'żółty
'DoCmd.OpenForm "Drukuj", acDesign, , , , acHidden
'Forms!Drukuj.Controls("Etykieta" & i).BackStyle = 1
'Forms!Drukuj.Controls("Etykieta2").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)
'Forms!Drukuj.l2.BackColor = RGB(255, 255, 2)
End Sub
Private Sub Etykieta3_Click()
'DoCmd.GoToRecord , , acGoTo, 3
'Me.Etykieta3.BackStyle = 1
' Me.Etykieta3.BackColor = RGB(255, 255, 2) 'żółty
'Forms!Drukuj.Controls("Etykieta" & i).BackStyle = 1
'Forms!Drukuj.Controls("Etykieta3").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)
End Sub
Private Sub Etykieta4_Click()
'DoCmd.GoToRecord , , acGoTo, 4
' Me.Etykieta4.BackStyle = 1
' Me.Etykieta4.BackColor = RGB(255, 255, 2) 'żółty
End Sub
Private Sub Etykieta5_Click()
'DoCmd.GoToRecord , , acGoTo, 5
' Me.Etykieta5.BackStyle = 1
' Me.Etykieta5.BackColor = RGB(255, 255, 2) 'żółty
End Sub
Private Sub Etykieta23_Click()
'DoCmd.GoToRecord , , acGoTo, 23
End Sub
Private Sub Polecenie1218_Click()
Dim strPath As String
' open 'file open' dialogue and get path to selected file
strPath = GetFilePath()
If Len(strPath) > 0 Then
Me.MAPA = strPath 'ImagePath
Me.ctrlImage.Visible = True
Me.lblNoImage.Visible = False
End If
Exit_here:
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error"
Resume Exit_here
End Sub
Private Sub Polecenie1222_Click()
Me.MAPA = Null 'ImagePath
' hide image control and show 'No Image' label
Me.lblNoImage.Visible = True
Me.ctrlImage.Visible = False
End Sub
Private Sub Polecenie1725_Click()
DoCmd.OpenForm "Filtruj", WindowMode:=acDialog
End Sub
Private Sub SaveClip2Bit_Click()
DoCmd.OpenForm "Drukuj", WindowMode:=acDialog
End Sub
Private Sub Detail_Click()
Call SetLabelColour
End Sub