Błąd ten pojawia się często przy używaniu zmiennej Single, którą przypisujemy do komórki. Np zamiast 1 widzimy 1,0000001 lub 0,9999999. O dziwo błąd ten często daje się usunąć po zmianie typu na Double 🙂
Archiwum autora: Dariusz Kolasa
Warunkowe usuwanie wierszy
Spory kawałek kodu jak na tak prosty w sumie problem a to dlatego, że aplikacja sprawdza sobie najpierw czy ma z czym pracować i na dodatek robi kopię skasowanych wierszy
Option Explicit Public Const WERSJA = "Warunkowe usuwanie wierszy v.1.0 (Akademia-VBA.pl)" Public Const KOL_SPRAWDZANA As Long = 3 ' ' Usuwa wiersz zakresu z nagłówkami gdy w kolumnie 3 jest pusto ' Usunięte wiersze zapisuje na wszelki w dodatkowym arkuszu ' Wcześniej aplikacja sprawdza, czy są dane ' i czy użytkownik ustawił w nich komórkę aktywną ' Sub WarunkoweUsuwanieWierszy() Dim Zakres As Range Dim LW As Long, W As Long Dim Wiersz As Range Dim x As Long Dim ArkUsuwanychWierszy As Worksheet Dim Naglowki As Range If NienormalnyArkusz Then Exit Sub If NienormalneOkno Then Exit Sub If BrakZakresu Then Exit Sub Set Zakres = ActiveCell.CurrentRegion Set Naglowki = Zakres.Rows(1) Set ArkUsuwanychWierszy = Sheets.Add() ArkUsuwanychWierszy.Name = "Skasowane" & StempelCzasowy Naglowki.Copy ArkUsuwanychWierszy.Range("A1") LW = Zakres.Rows.Count For W = LW To 2 Step -1 Application.StatusBar = "Analiza wiersza " & W If Len(Zakres.Cells(W, KOL_SPRAWDZANA)) = 0 Then 'czyli gdy pusto x = x + 1 Set Wiersz = Zakres.Rows(W) Wiersz.Copy ArkUsuwanychWierszy.Cells(x + 1, 1) Wiersz.Delete End If Next ArkUsuwanychWierszy.UsedRange.EntireColumn.AutoFit Application.StatusBar = False MsgBox "Poczatkowa liczba wierszy: " & LW & vbNewLine & _ "Liczba wierszy usuniętych: " & x & vbNewLine & _ "Pozostało wierszy: " & LW - x, vbInformation, WERSJA End Sub Private Function NienormalnyArkusz() As Boolean If ActiveSheet.Type <> xlWorksheet Then MsgBox "Ustaw się w arkuszu danych!", vbExclamation, WERSJA NienormalnyArkusz = True End If End Function Private Function NienormalneOkno() As Boolean If ActiveWindow.Type <> xlWorkbook Then MsgBox "Ustaw się w oknie danych!", vbExclamation, WERSJA NienormalneOkno = True End If End Function Private Function BrakZakresu() As Boolean If Len(ActiveCell) = 0 Then MsgBox "Ustaw się w niepustej komórce zakresu danych!", vbExclamation, WERSJA BrakZakresu = True End If End Function Function StempelCzasowy() As String StempelCzasowy = Format(Now(), "_yyyymmdd_hhmmss") End Function |
Przyszłość VBA
To ważny temat dla autora tej strony 🙂
Oto kilka cytatów:
1. Dick Kusleika
12 krotny zdobywca tytułu MVP, znawca Office System, SharePoint Server i .NET:
I don’t care if VBA is dead. It still works for me now, I’m very effective with it, and I’m still solving real problems using it every day. If it’s dead, it’s the best damn corpse in the office.
Fajne 🙂
2. Jacques Bourgeois (James Burger)
Ma oficjalny tytuł Geniusza na experts-exchange.com (ok 2,5 miliona punktów od użytkowników)
Enterprises love Word and Excel because they can push them over what they can do through VBA or VB.NET applications. And how does Microsoft react to that love. By toning down Office with these stupid ribbons in 2007, and then removing VBA in their cloud incarnations.
With my 40 years in programming (first as a hobbyist, then as an engineer, and the last 23 as a full time programmer) I have a little bit of experience. And as many programmers of my age, I have the impression that
we are going back to the 80’s, where most of the programmer’s time is spent trying to make the interface work correctly
Przygnębiające ale prawdziwe 🙁
Podsumowując:
Największym wrogiem VBA jest … Microsoft.
VBA nie jest rozwijane praktycznie od ponad 20 lat (może to i lepiej, patrząc na jakość dzisiejszych produktów). Microsoft Office jest coraz wolniejszy, niestabilny, nieergonomiczny. Buja w chmurach i nie obsługuje w nich VBA
Miejmy nadzieję, że ktoś w Microsoft się ocknie i zrozumie, że nie wszystko musi służyć do zabawy na tablecie…
Nawiasem mówiąc najpoważniejszym wrogiem VBA było VSTO (Visual Studio Tools for Office). Microsoft od wersji 2012 już go nie wspiera…
Współczuję tym, którzy zainwestowali 10 lat pracy w ten produkt…
Obecnie w dobie Office 365 największym zagrożeniem dla VBA jest …. HTML, JavaScript i CSS!. To nie żart. Takie są najnowsze plany Microsoftu!
Ja póki co, nadal trzymam się VBA 😉
Źródła:
http://dailydoseofexcel.com/archives/2014/11/08/the-future-of-vba-
development/)
http://www.experts-
exchange.com/Programming/Microsoft_Development/Q_28328440.html
ADO – i wszystkie bazy są nasze :)
Od 2000 roku czyli już od kilkunastu lat Microsoft Office może bez problemu łączyć się w zasadzie z dowolnymi bazami danych, dzięki bibliotece ADO (Microsoft ActiveX Data Object XX Library). I od tych samych kilkunastu lat budzi to niezmiennie zdziwienie wśród moich klientów i studentów. Jak to? Excel może pobrać dane z Oracle?, SQL Servera? O! Może nawet je edytować?! No oczywiście, że może, i to od wielu lat…
Biblioteka ADO (w kodzie widoczna jako ADODB) jest domyślnie podłączana tylko w Accessie. We wszystkich innych produktach, w tym w Excelu trzeba ją wybrać w referencjach. Tools – References – Microsoft ActiveX Data Object XX Library, gdzie XX to numer wersji biblioteki, ja osobiście wybieram zwykle wersję 2.8
Drugi warunek to oczywiście poprawnie zainstalowany sterownik OLEDB do określonej bazy (http://en.wikipedia.org/wiki/OLE_DB_provider)
Poniżej przykład pobierający do Excela dane z Accessa 2003, ale uważny czytelnik zobaczy drogę pobierania z Accessa 2007/10/13 tudzież z SQL Servera. Wystarczy podmienić wartość właściwości ConnectionString obiektu Connection
Option Explicit Public Const WERSJA As String = "ADO Klient v.0.1" Public Const ARK_DANE As String = "Dane" Public Const ZRODLO As String = "tbBrutto" 'Załozenia: ' - mamy arkusz o nazwie "Dane" ' - mamy bazę PodstawyVBA.mdb a w niej tabelę tbBrutto ' - mamy sterownik do mdb 'Access mdb '========== Public Const CN_STR As String = _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=D:\kursy\AC04\PodstawyVBA.mdb;" & _ "Persist Security Info=False" 'Ponizej przykłady konfiguracji dla innych baz 'Access accdb '============ 'Public Const CN_STR As String = _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=D:\kursy\AC04\PodstawyVBA.accdb;" & _ "Persist Security Info=False" 'SQL Server '========== 'Public Const CN_STR As String = _ "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _ "Persist Security Info=False;" & _ "Initial Catalog=Produkcyjna;" & _ "Data Source=SKARBEKMC\SQLEXPRESS" Sub OdczytDoExcela() Dim Zakres As Range Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset On Error GoTo Obsluga Sheets(ARK_DANE).Select Range("A1").Select Set Zakres = _ Sheets(ARK_DANE).Range("A1").CurrentRegion Zakres.ClearContents cn.ConnectionString = CN_STR cn.Open rs.Open ZRODLO, cn Sheets(ARK_DANE).Range("A2").CopyFromRecordset rs 'nagłówki Dim LK As Long, K As Long LK = rs.Fields.Count For K = 1 To LK Sheets(ARK_DANE).Cells(1, K) = rs.Fields(K - 1).Name Next Zakres.EntireColumn.AutoFit Czyszczenie: On Error Resume Next rs.Close Set rs = Nothing cn.Close Set cn = Nothing Exit Sub Obsluga: MsgBox Err.Number & " - " & Err.Description, vbExclamation, WERSJA Resume Czyszczenie End Sub |
Piszą o mnie :)
Ostatnio zaprzyjaźniony blog się o mnie wypowiedział 😉
http://malinowyexcel.pl/jak-zamienic-kropki-na-przecinki-za-pomoca-makra-vba/
Kopiowanie i linkowanie plików Worda
Ostatnio dotknąłem się do programowania Worda. Nie było to przyjemne uczucie 😉
No ale w końcu jest to Akademia VBA a nie Akademia VBA Excel i Access 🙂
Po zaznaczeniu jakiegoś tekstu kod kopiuje aktywny plik pod nazwą jak zaznaczenie i od razu robi link do niego. Używa też fajnej funkcji do odczyszczania tekstu ze zbędnych znaków specjalnych i innych zabronionych w nazwach obiektów i plików
Sub UtworzKopiePliku_i_Link() Dim MojDokument As Word.Document Dim Kopia As Word.Document Dim ZaznTekst As String Dim SciezkaMojDokument As String Dim SciezkaFolder As String ZaznTekst = fnCzystyTekst(Selection.Range.Text) If Len(ZaznTekst) = 0 Then MsgBox "Brak zaznaczenia!" Exit Sub End If Set MojDokument = ThisDocument SciezkaMojDokument = MojDokument.FullName SciezkaFolder = MojDokument.Path & "\" MojDokument.Bookmarks.Add ZaznTekst, Selection MojDokument.Save MojDokument.SaveAs SciezkaFolder & ZaznTekst & ".docm" Set Kopia = MojDokument Set MojDokument = Documents.Open(SciezkaMojDokument) Selection.GoTo What:=wdGoToBookmark, Name:=ZaznTekst MojDokument.Hyperlinks.Add Anchor:=Selection.Range, _ Address:=Kopia.Name, TextToDisplay:=ZaznTekst Set MojDokument = Nothing Kopia.Close Set Kopia = Nothing End Sub Function fnCzystyTekst(Tekst As String) Dim Znak As String * 1, NrZnaku As Long For NrZnaku = 1 To Len(Tekst) Znak = Mid(Tekst, NrZnaku, 1) If Znak Like "[A-Z,a-z,0-9,Ć,Ę,Ł,Ó,Ś,Ż,Ź,ć,ę,ł,ó,ś,ż,ź]" Then fnCzystyTekst = fnCzystyTekst & Znak End If Next End Function |
Jak zablokować wklejanie do komórek z ustawionym sprawdzaniem poprawności
Nie jest to specjalnie prosta ani ładna procedura, ale działa 🙂
Jak widać powinna być umieszczona w module prywatnym arkusza
Powoduje ona wykrycie i cofnięcie wklejania do komórek z ustawionym sprawdzaniem poprawności
Private Sub Worksheet_Change(ByVal Target As Range) Dim BylaZmiana As Boolean Dim ZakresWspolny As Range On Error GoTo Obsluga 'jeśli to spowoduje błąd to nie ma zmian w chronionym zakresie A1:A2 Application.Intersect(Me.Range("A1:A2"), Target).Select BylaZmiana = True 'ta linia prawdopodobnie spowoduje błąd gdy było wklejanie If Target.Validation.Type <> xlValidateDate Then Resume Next Czyszczenie: On Error Resume Next Application.EnableEvents = True Exit Sub Obsluga: Select Case Err Case 91 'prawdopodobnie do zignorowania Case 1004 If BylaZmiana Then 'prawdopodobnie błąd spowodowany wklejeniem w chronionym zakresie MsgBox "Nie wolno niszczyć sprawdzania poprawności!", vbExclamation Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If Case Else MsgBox Err & " - " & Err.Description, vbCritical End Select Resume Czyszczenie End Sub |
Odświeżanie nazwanych zakresów
Często pojawiającym się problemem jest zmiana zakresów nazwanych zakresów 🙂
Poniższy kod dopasuje nowe zakresy do ich nazw. Opieramy się na założeniu, że zakresy nie sąsiadują bezpośrednio z innymi danymi
Sub AktualizujNazwy() Dim Nazwa As Name For Each Nazwa In Names Nazwa.RefersToRange.CurrentRegion.Name = Nazwa.Name Next End Sub |
Usuwanie fragmentów tekstu ograniczonego parą znaków
Ostatnio dwukrotnie zostałem poproszony o rozwiązanie problemu usuwania części tekstu pomiędzy parą znaków
Np „Ala (hihi) ma kota (hehe) a kot to” – powinno zostać zamienione na „Ala ma kota a kot to”
Oto rozwiązanie, pisane jak zwykle na szybko, więc pewnie ktoś już to kiedyś zrobił lepiej 🙂
' Wymaga biblioteki Excela ' ze względu na obiekt WorksheetFunction Function PominTekst( _ Tekst As String, Ogr1 As String, Ogr2 As String, _ BezZbednychSpacji As Boolean) Dim Pocz As Long, Wynik As String Dim PozOgr1 As Long Dim PozOgr2 As Long Pocz = 1 Do PozOgr1 = InStr(Pocz, Tekst, Ogr1) If PozOgr1 = 0 Then Exit Do PozOgr2 = InStr(PozOgr1 + 1, Tekst, Ogr2) Wynik = Wynik & Mid(Tekst, Pocz, PozOgr1 - Pocz) Pocz = PozOgr2 + 1 Loop Wynik = Wynik & Mid(Tekst, Pocz) If BezZbednychSpacji Then PominTekst = WorksheetFunction.Trim(Wynik) Else PominTekst = Wynik End If End Function |
Pobieranie pliku ze strony WWW
Można tego dokonać całkiem prosto:
Sub PobierzPlik() Dim Link As String Link = "http://serwer.pl/pliki/katalog.csv" ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True End Sub |