Witam czy jest możliwość zoptymalizowania tego kody, proszę o radę i podpowiedzi
w załączniku jak to wygląda w oknie UserForm wszystko tworzy się automatycznie
Private Sub UserForm_Initialize()
Dim n As Integer, c As Integer, r As Integer
Dim koord As String
Dim Liczba, k, a, v, u, z, j, t, plus, ile, Licznik_lab, w, D As Long
Dim licznik As Long
Dim Przeglad_Do As Long
Dim Przeglad_Od As Long
Dim Data_Kontroli As Long
Dim Numer_tester As String
Dim Od_plik, Do_plik, TESTER_plik As String
Dim Ilosc_prze, jest As Long
Dim Tablica_Przeg()
Dim Butn As CommandButton
Dim vidSzer As Integer
Dim vidWys As Integer
Dim Msg As String
Dim data, dane
Dim Dane_config
Dim Tester_potwierdzenie, Nazwa_Pliku
Dim mnoznik, mnoznik_1, miesiac_kontroli
Dim plik As String
'język
With Sheets("jezyk")
Lab_1.Caption = .Cells(679, 1).Value
Lab_2.Caption = .Cells(680, 1).Value
Lab_3.Caption = .Cells(681, 1).Value
Lab_4.Caption = .Cells(682, 1).Value
Harmonogram_kontroli_testerow.Caption = .Cells(684, 1).Value
End With
'koniec
' dopasowanie do kona monitora
vidSzer = GetSystemMetrics(SM_CXSCREEN)
vidWys = GetSystemMetrics(SM_CYSCREEN)
Harmonogram_kontroli_testerow.Left = 100
Harmonogram_kontroli_testerow.Top = 80
Harmonogram_kontroli_testerow.Width = vidSzer - (vidSzer * 0.25)
Harmonogram_kontroli_testerow.Height = vidWys - (vidWys * 0.29)
' Dla rozdzielczosci
If vidSzer = 800 And vidWys = 600 Then
mnoznik = 0
mnoznik_1 = 0
End If
If vidSzer = 1280 And vidWys = 768 Then
mnoznik = 0.3
mnoznik_1 = 0.03
End If
'ustawia przyciski zamknij
With Harmonogram_kontroli_testerow.Zamknij
.Left = 800 + (20 * mnoznik)
.Top = 480 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
' Label z informacjami
With Harmonogram_kontroli_testerow.Lab_1
.Left = 830 + (20 * mnoznik)
.Top = 55 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
' .Left = 150
' .Top = 10
' .Height = 20
End With
With Harmonogram_kontroli_testerow.Lab_2
.Left = 830 + (20 * mnoznik)
.Top = 75 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
With Harmonogram_kontroli_testerow.Lab_3
.Left = 830 + (20 * mnoznik)
.Top = 95 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
With Harmonogram_kontroli_testerow.Lab_4
.Left = 830 + (20 * mnoznik)
.Top = 115 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
' Label z kolorami
With Harmonogram_kontroli_testerow.zolty
.Left = 800 + (20 * mnoznik)
.Top = 50 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
With Harmonogram_kontroli_testerow.pomaranczowy
.Left = 800 + (20 * mnoznik)
.Top = 70 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
With Harmonogram_kontroli_testerow.zielony
.Left = 800 + (20 * mnoznik)
.Top = 90 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
With Harmonogram_kontroli_testerow.czerwony
.Left = 800 + (20 * mnoznik)
.Top = 110 - (20 * mnoznik_1)
.Height = 20 - (55 * mnoznik_1)
End With
' koniec
' wyszukuje numer testera i datę jego kontroli
If LenB(Dir$(Przeglad_TESTEROW)) Then
' Przeglad_TESTEROW = "C:\Przeglad_tester.prze"
Open Przeglad_TESTEROW For Input As #1 'Otwiera plik z koordynatami labeli
Do Until EOF(1)
Line Input #1, data
data = Replace(data, """", "")
dane = Split(data, ",")
TESTER_plik = dane(0)
Od_plik = dane(1)
Do_plik = dane(2)
Ilosc_prze = Ilosc_prze + 1
ReDim Preserve Tablica_Przeg(Ilosc_prze)
Tablica_Przeg(Ilosc_prze) = TESTER_plik & "/" & Od_plik & "/" & Do_plik ' dodanie do tablicy
Loop
Close #1
Else
MsgBox Sheets("jezyk").Cells(683, 1).Value, vbCritical, Sheets("jezyk").Cells(633, 1).Value
Exit Sub
End If
On Error GoTo 0
Data_Kontroli = Left(Format(Date, "dd.mm.yyyy"), 2)
Licznik_lab = 1
plus = 0
For ile = 1 To Ilosc_prze
licznik = 0
Dane_config = Split(Tablica_Przeg(ile), "/")
Numer_tester = Dane_config(0)
Przeglad_Od = Dane_config(1) ' data kontroli od danego dnia
Przeglad_Do = Dane_config(2) ' data kontroli do danego dnia
' Sprawdza czy tester jest zapisany w pliku pdf
On Error Resume Next
miesiac_kontroli = Format(Date, "mm-yyyy")
plik = Dir(sciezka & miesiac_kontroli & "\" & "*.pdf") ' wybór pliku pdf w katalogu
Do While plik <> "" ' pętla Do dla pliku PDF
Tester_potwierdzenie = Split(Numer_tester, " *")
Nazwa_Pliku = Split(plik, ".pdf")
If Nazwa_Pliku(0) = Tester_potwierdzenie(0) Then
jest = 1
Exit Do
Else
jest = 0
End If
plik = Dir
Loop
If plik = "" Then ' warunek jeżeli w katalogu nie ma pliku PDF
plik = "pusty.pdf" ' wstawia nazwę pliku
Nazwa_Pliku = Split(plik, ".pdf")
End If
If jest = 1 Then ' warunek czy tester jest kontrolowany w danym miesiącu
Else
If ((Data_Kontroli >= Przeglad_Od And Data_Kontroli <= Przeglad_Do) And (Nazwa_Pliku(0) <> 0 And jest = 0)) Or ((Data_Kontroli >= Przeglad_Od And Data_Kontroli >= Przeglad_Do) And (Nazwa_Pliku(0) <> 0 And jest = 0)) Then
u = 0
For v = 1 To 31
c = 1
'Pobranie danych odnośnie wydziału dla danego testera
With Sheets("spis")
w = .Cells(Rows.count, 2).End(xlUp).Row ' wiersz w spis
D = WorksheetFunction.Match(Numer_tester, Worksheets("Spis").Range("C1:C" & w), 0) ' podaje numer wiersza dla szukanej wartości
End With
' Dodanie przycisku do nr testera
For t = 1 To 1
Set Butn = Harmonogram_kontroli_testerow.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = Numer_tester & " * " & Sheets("spis").Cells(D, 16).Value 'Numer_tester
.Caption = Numer_tester & " * " & Sheets("spis").Cells(D, 16).Value
.ControlTipText = Numer_tester & " * " & Sheets("spis").Cells(D, 16).Value
.FontSize = (7)
.Width = 100
.Height = 17
.Left = (20 + c * 9)
.Top = 10 + plus
End With
' Dodanie labela z liczbą począrtkową
With Harmonogram_kontroli_testerow
With .Controls.Add("forms.Label.1") 'Dodaj labele do okna UserForm
.Width = 17
.Height = 17
.Left = 10
.Top = 10 + plus
.Name = Licznik_lab
.Caption = Licznik_lab & "."
.FontSize = (11)
.TextAlign = fmTextAlignCenter
End With
End With
Next t
' dodanie labeli z numerenm dnia
With Harmonogram_kontroli_testerow
With .Controls.Add("forms.Label.1") 'Dodaj labele do okna UserForm
.Width = 17
.Height = 17
.Left = (130 + c * 17 + u)
.Top = 10 + plus
licznik = licznik + 1
.Name = koord & "_" & licznik
.Caption = licznik
.FontSize = (12)
.TextAlign = fmTextAlignCenter
.BackColor = &HE0E0E0
If licznik >= Przeglad_Od And licznik <= Przeglad_Do Then
.BackColor = &HC000& ' nadaje kooordynacie zielony kolor ( termin kontroli który pozostał)
End If
If licznik >= Przeglad_Od And licznik <= Data_Kontroli - 1 Then
.BackColor = &HFFC0C0 '&HC0E0FF ' nadaje kooordynacie pomarańcz kolor ( termin kontroli
End If
'******************
If licznik - 1 >= Przeglad_Do And licznik <= Data_Kontroli - 1 Then
.BackColor = &HFF& ' nadaje kooordynacie czerwony kolor (termin po kontroli)
End If
'***************
If licznik = Data_Kontroli Then
.BackColor = &HFFFF& ' nadaje kooordynacie złóty kolor (dzisiaj)
End If
End With
End With
c = c + 1
u = u + 17
Next v
plus = plus + 22
Licznik_lab = Licznik_lab + 1
End If
End If
Next ile
Set Butn = Nothing
Call zaznacz
If Licznik_lab = 1 Then
With Harmonogram_kontroli_testerow
With .Controls.Add("forms.Label.1") 'Dodaj labele do okna UserForm
.Left = 200 + (20 * mnoznik)
.Top = 70 - (20 * mnoznik_1)
.Height = 300 - (55 * mnoznik_1)
.Width = 500
.Top = 300
.Name = Licznik_lab
.FontSize = (20)
.TextAlign = fmTextAlignCenter
.ForeColor = &H8000&
.Caption = Sheets("jezyk").Cells(688, 1).Value
End With
End With
End If
End Sub |