vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest poniedziałek, 29 kwietnia 2024 roku.
Ustaw jako stronę startową Ulubione Napisz
PowrótPowrót do serwisu  RegulaminRegulamin rssRSS

  tytuł wątku:
Wątki dyskusji

optymalizacja kodu


otwartyotwarty rozpoczął: Blaszka_P postów: 1



napisał: Blaszka_P
postów: 112


umieszczony:
12 listopada 2012
19:32

  
nazwa pliku rozmiar
userform.JPG 164.31 kB

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



<-wstecz  1  dalej->
wszystkich stron: 1


Sortuj posty: z