Moje doświadczenia z Excelem, Accesem i programowaniem w VBA

Wpisy z tagiem: kod VBA

sobota, 21 listopada 2015

Kilka lat temu napisałam na tym blogu notkę na temat odczytu listy plików z katalogu:

Odczyt listy plików z katalogu

Kilka dni temu zostałam poproszona o modyfikację przedstawionego tam makra tak, aby pliki nie tylko zostały wylistowane, ale aby w skoroszycie znalazły się do nich hiperłącza.

Nowe makro wygląda tak:

Public Sub ListaPlikow()

Dim Katalog As String
Dim NazwaPliku As String
Dim IndexSheet As Worksheet
Dim KolejnyWiersz As Long

KolejnyWiersz = 3

Set IndexSheet = ThisWorkbook.ActiveSheet
Katalog = Range("b1").Value
If Right(Katalog, 1) <> "\" Then Katalog = Katalog & "\"
If Dir(Katalog, vbDirectory) = "" Then
    MsgBox "Brak katalogu", vbCritical, "Błędne dane"
    IndexSheet.Cells(2, 2).Activate
    Exit Sub
End If
NazwaPliku = Dir(Katalog & "*.xls*")
Do While NazwaPliku <> ""
IndexSheet.Hyperlinks.Add Anchor:=Cells(KolejnyWiersz, 1), Address:=Katalog & NazwaPliku, _
        TextToDisplay:=NazwaPliku
KolejnyWiersz = KolejnyWiersz + 1
NazwaPliku = Dir
Loop
 
End Sub

Plik do pobrania jest na Dropboxie:

Lista plików

Dodatkowo jest tam umieszczone makro czyszczące zakres wprowadzanych danych.

 




 

 

Excel 2013 i programowanie VBA

 


 

Kurs Excel programowanie w VBA>

wtorek, 10 września 2013

W komentarzach do jednej ze starszych notek:

Odczyt i porównanie wartości komórek z wielu plików

pojawił się problem z odświeżaniem łączy w pliku. Wprawdzie na podstawie przekazanych mi informacji nie wiem, co może być tego przyczyną, ale odpowiadając na prośbę czytelnika - zamieszczam makro otwierające i od razu zamykające wszystkie pliki z danego katalogu.
Na pewno odświeży to wartości we wszystkich powiązanych komórkach. Adres katalogu jest pobierany z komórki A1 aktywnego arkusza. Otwieranie i zamykanie kolejnych plików odbywa się w tle - na czas wykonywania makra wyłączone jest odświeżanie ekranu.

Public Sub OtworzPliki()

Dim Katalog As String
Dim NazwaPliku As String
Application.ScreenUpdating = False
Katalog = Range("A1").Value
If Right(Katalog, 1) <> "\" Then Katalog = Katalog & "\"
NazwaPliku = Dir(Katalog & "*.xls*")
Do While NazwaPliku <> ""
Workbooks.Open Filename:=Katalog & NazwaPliku, ReadOnly:=True
ActiveWindow.Close savechanges:=False
NazwaPliku = Dir
Loop
Application.ScreenUpdating = True
End Sub

Mam nadzieję, ze teraz będzie działać.

 


 

 

 

 

 

 

 

Kurs Excel programowanie w VBA



wtorek, 29 maja 2012

Nazwa pliku w kodzie VBA wyznaczana jest poprzez słowo kluczowe Name.
Chcąc wyznaczyć nazwę aktualnie otwartego pliku wystarczy prosta funkcja:

Private Function Nazwa_Pliku()

Nazwa_Pliku=ActiveWorkbook.Name

End Function

Właściwość Name obiektu ActiveWorkbook wyznacza nazwę aktywnego skoroszytu.


Ścieżka dostępu do katalogu w kodzie VBA wyznaczana jest poprzez słowo kluczowe Path.
Chcąc wyznaczyć katalog aktualnie otwartego pliku wystarczy prosta funkcja:

Private Function Nazwa_Katalogu()

Nazwa_Katalogu=ActiveWorkbook.Path

End Function

Właściwość Path obiektu ActiveWorkbook wyznacza właśnie katalog, w którym znajduje się aktywny skoroszyt.


sobota, 11 lutego 2012

Problem wygląda tak: jest arkusz Excela z tabelą i potrzebne jest makro, które będzie drukowało określoną wartością jednej z komórek liczbę kopii. Jego rozwiązanie może być dobrym przykładem na ilustrację procesu nagrywania i edycji makra.

W arkuszu mamy tabelę. Wyróżniona została tu komórka I15, która ma determinować liczbę kopii wydruku. Oczywiście musi to być liczba całkowita.

makro

Nagrywanie makra rozpoczynamy na wstędze Developer, wybierając przycisk
Zarejestruj makro.

rejestrowanie makra 

Po naciśnięciu tego przycisku - wszystkie czynności będą rejestrowane i powtórzone po każdym uruchomieniu makra.Sam przycisk zmienia się na Zatrzymaj rejestrowanie i służy do zakończenia jego nagrywania.

rejestrowanie makra

 

Nagrywając makro do tego przykładu - ustawiłam liczbę kopii na 5. Żeby zmienić to na wartość odczytywaną z komórki I15 - przejść do edycji makra w kodzie VBA.
Na wstędze Developer - wybieramy przycisk Visual Basic.

edytor Visual Basic 

 

Z lewej strony edytora odszukujemy moduł 1 - tam jest zarejestrowane nasze makro:

Projekt VBA

Dwukrotne kliknięcie w moduł powoduje jego otwarcie

edytor Visual Basic

Widać tu zapisane w kodzie VBA makro. Kluczowa w zapisie jest jest liczba 5 - taka ilość kopii była początkowo ustawiona i właśnie w tym miejscu konieczna jest zmiana.
Z Makra1 skopiowałam funkcję wywołującą drukowanie (uwaga: w zależności od drukarki i ustawienia pozostałych parametrów wydruku może się nieco różnić) . Stworzyłam nowe makro Druk, w którym wstawiłąm skopiowany fragment, nieco go zmieniając.
Tam, gdzie byla liczba 5 - czyli liczba kopii ustawiona podczas nagrywania makra - wstawiłam wartośc zmiennej IleKopii. W moim przypadku - zmienna ta odwołuje się do komórki I15, ale można wstawić tu dowolną inna komórkę. Ważne, aby była to liczba naturalna.

Sub Makro1()
'
' Makro1 Makro
'
 
'
    ExecuteExcel4Macro "PRINT(1,,,5,,,,,,,,2,,,TRUE,,FALSE)"
End Sub
 
Public Sub Druk()
Dim IleKopii As Integer
 
IleKopii = Range("I15").Value
 

 ExecuteExcel4Macro "PRINT(1,,," & IleKopii & ",,,,,,,,2,,,TRUE,,FALSE)"
End Sub


Teraz pozostaje już tylko zapisanie pliku - jako skoroszytu z obsługą makr - rozszerzenie
xlsm.

makro

Oczywiście pozostaje jeszcze kwestia jak uruchamiać makro. To zagadnienie opisane jest tu:
Uruchamianie makra

A całość w formie tutorialu jest tu:

Przykładowe makro

 

Przykład makra, które ma drukować określoną wartością jednej z komórek arkusza liczbę kopii.

Opis poszczególnych kroków jest tu:

Nagrywanie i edycja makra

 

poniedziałek, 14 lutego 2011

Formatowanie warunkowe jest jednym z ciekawszych narzędzi własnych Excela. Pisałam o tym tu:
Formatowanie warunkowe
Formatowanie warunkowe nieco bardziej zaawansowane
Przydaje się w praktycznym wykorzystaniu, gdy wyróżnienie okreśłonych danych może pomóc w analizie czy choćby uatrakcyjnić wygląd arkusza.
Problem pojawia się wtedy, gdy potrzebujemy więcej warunków formatowania niż ograniczona liczba dostępnych warunków systemowych. W takiej sytuacji możemy wykorzystać swoje własne formatowanie za pomocą kodu VBA.

Dobrym przykładem może być tu miesięczny grafik dyżurów dla 15 osób.

formatowanie arkusza Excel 

W legendzie - czyli komórkach F3 do G17 oznaczeniom L1 do L15 przypisujemy kolory wypełnienia komórki. Formatowanie to automatycznie przenosi się do samego grafika czyli komórek A1 do D32.

Zdefiniujmy najpierw konieczne funkcje i procedury


Public Function Kolorek(Symbol)

Dim Przeglad As Range 
For Each Przeglad In Range("F3:F20")
    If Przeglad.Value = Symbol Then
       Kolorek = Przeglad.Interior.Color
       Exit Function
    End If
Next
Kolorek = 0

End Function

Funkcja Kolorek wyszukuje Symbol (czyli wartość komórki będącej argumentem funkcji) w obszarze Range (w tym przypadku zdefiniowanej komórkami Legendy w arkuszu Excela). Obszar jest przeszukiwany w ramach pętli For Each...Next (zob. Pętla For Each ... Next) i gdy wynik poszukiwania jest pozytywny - funkcja Kolorek przyjmuje wartość numeru koloru tła.

Kolor mamy ustalony, potrzebna jest jeszcze procedura zmieniająca kolory w samym arkuszu.


Public Sub Pokoloruj()

Dim JakiKolor
Dim Komorka As Range
Dim JakiSymbol
 For Each Komorka In Range("B2:F40")
       JakiSymbol = Komorka.Value
       If JakiSymbol <> "" Then
              JakiKolor = Kolorek(JakiSymbol)
              If JakiKolor = 0 Then Komorka.Interior.Pattern = xlNone Else Komorka.Interior.Color = JakiKolor
             
        Else
         Komorka.Interior.Pattern = xlNone
        End If
 Next
 End Sub

Procedura Pokoloruj przechodząc przez poszczególne komórki grafika (czyli zakres B2 do F40), na podstawie ich wartości przypisanej do zmiennej Symbol w fukcji Kolorek, sprawdza i zmienia kolor komórek w grafiku.

Teraz wystarczy tylko stworzyć przycisk uruchamiający makro Pokoloruj. Prosciej jednak byłoby przypisać je do któregoś ze zdarzeń arkusza lub zdarzeń skoroszytu.  
Na przykład tak:

Private Sub Worksheet_Activate()
Pokoloruj
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column < 8 And Target.Row < 33 Then Pokoloruj

End Sub

Makro działa w tym przypadku przy otwarciu arkusza oraz przy zmianie wartości komórek z określonego zakresu.  

sobota, 18 września 2010

Ciąg dalszy poprzedniej notki
Odczyt listy plików z katalogu
Skoro w arkuszu już mamy listę plików - to pora odszukać w nich wartości odpowiednich komórek. Żeby w prosty sposób sprawdzic efekt działania makra - moje przykładowe arkusze wypełniłam liczbami, w których każda cyfra ma znaczenie. Pierwsza oznacza numer zeszytu, druga - arkusza, trzecia - kolumna, a czwarta - wiersz.
Np. dla pliku Zeszyt3 arkusz pierwszy wygląda tak:

lista plików 

Plik Zbiorowka, gdzie w nagłówku wpisujemy dane, które chcemy porównać - ma taką postać:

lista plikow

Kod makra, które wstawia łącza do odpowiednich komórek odpowiednich plików:

Public Sub WpiszDane()
Dim Kolumna As Range
Dim Komorka As Range
Dim Gdzie As String
Dim JakiKatalog As String
Dim JakiPlik As String
Dim JakiArkusz As String
Dim JakaKomorka
Dim Wartosc
Dim i As Integer

JakiKatalog = Range("A1").Value
i = 0
For Each Kolumna In Range("B1:Z1")
 If Kolumna.Value <> "" Then
    i = i + 1
    JakiArkusz = Kolumna.Value
    JakaKomorka = Kolumna.Offset(1, 0).Value
        For Each Komorka In Range("a3:a1000")
            If Komorka.Value <> "" Then
               JakiPlik = Komorka.Value
               Gdzie = "'" & JakiKatalog & "\" & "[" & JakiPlik & "]"&_
               JakiArkusz & "'!" & JakaKomorka
               Wartosc = "=" & Gdzie
               Komorka.Offset(0, i).Value = Wartosc
            End If
         Next Komorka
  End If
Next Kolumna
End Sub

Makro najpierw odczytuje wartości w poszczególnych komórkach nagłówka, a następnie - przechodząc wzdłuż kolumny A z nazwami plików - w komórkach na przecięciu wstawia łącza do żródła.
Efekt końcowy wygląda tak:

lista plików 

 

Tym razem - temat wywołany pośrednio wątkiem z forum dyskusyjnego. Jest sobie katalog, w którym jest kilkaset plików Excela. Pliki są wypełniane zgodnie z ustalonym szablonem. Do ich analizy potrzebne jest porównanie wartości z kilku, ściśle określonych komórek, w kolejnych arkuszach. Jak to zrobić szybko i sprawnie? Najlepiej wykorzystując do tego VBA.

Na początek spróbujmy odczytać wszystkie nazwy plików w katalogu. Dla potrzeb tego przykładu - na dysku C założyłam katalog Arkusze i wrzuciłam tam 5 skoroszytów o nazwach Zeszyt1, Zeszyt2, Zeszyt3 ..itd. Wyniki zapisuję w pliku Zbiorówka.
Przykładowy kod makra odczytującego nazwy plików z danego katalogu wygląda tak:

Public Sub ListaPlikow()

Dim Katalog As String
Dim NazwaPliku As String
Dim IndexSheet As Worksheet
Dim KolejnyWiersz As Long

KolejnyWiersz = 3

Set IndexSheet = ThisWorkbook.ActiveSheet
Katalog = Range("A1").Value
Katalog = Katalog & "\"

NazwaPliku = Dir(Katalog & "*.xls")
Do While NazwaPliku <> ""
IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku
KolejnyWiersz = KolejnyWiersz + 1
NazwaPliku = Dir
Loop

Set IndexSheet = Nothing
End Sub

Zmienna Katalog odwołuje się do wartości komórki A1, w której wpisana jest nazwa katalogu. Zapisywanie nazw plików zaczyna się od wiersza 3 w kolumnie A - dwa pierwsze wiersze są nagłówkiem.
Efekt działania makra wygląda tak:

lista plików

 Ciąg dalszy - w kolejnej notce.

wtorek, 14 września 2010

Mała, bardzo pożyteczna instrukcja oszczedzająca czas i upraszczająca kod. Umożliwia odwołanie się do obiektu bez ciągłego powtarzania jego nazwy.
Wyobraźmy sobie, że chcemy zmienić formatowanie np. w Arkuszu1, w komórkach A1:A10.
Standardowy zapis wyglada tak:

Worksheets("Arkusz1").Range("A1:A10").Interior.Color = 65535
- zmiana koloru tła
Worksheets("Arkusz1").Range("A1:A10").Font.Name = "Freestyle Script"
- zmiana czcionki
Worksheets("Arkusz1").Range("A1:A10").Font.Underline = True
- podkreślenie czcionki 

Z wykorzystaniem instrukcji With ten sam zapis wygląda tak:

With Worksheets("Arkusz1").Range("A1:A10")
         .Interior.Color = 65535 
         .Font.Name = "Freestyle Script"
         .Font.Underline = True
End With

Prawda, że krócej i "czyściej"? Instrukcja moze być wykorzystywana w stosunku do wszystkich kolekcji.

 
1 , 2
| < Lipiec 2017 > |
Pn Wt Śr Cz Pt So N
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            


Książki warte polecenia
zobacz szczegóły...


A tu oferta na dziś:





ministat liczniki.org



Napisz do mnie!