makravba.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest sobota, 30 maja 2020 roku.
Ustaw jako stronę startową Ulubione Napisz
16 września 2017

Zapraszam na stronę Makra.VBA na Facebooku.

zamieścił: admin




Porada 24 lutego 2017
Instalator dodatków Excela.

Poniższy kod VBS służy do instalacji dodatków Excela (plikow *.xlam).

Plik VBS z poniższym kodem musi się znajdować w katalogu, w którym znajduje się plik *.xlam. Wraz z plikiem *.xlam zostaną skopiowane do katalogu dodatków także wszystkie inne pliki (na przykład pliki pomocy), które się w tym katalogu znajdują, oprócz pliku VBS.

Const sInstalator = "Instalator"
Dim oExcel

On Error Resume Next

Set oExcel = GetObject(,"Excel.Application")

If Err.Number = 0 Then
     MsgBox "Um die Installation weiter durchfüren zu können, schließen Sie Excel.", vbCritical, sInstalator
Else
     Err.Clear

     Const sExt = "xlam"
     Dim oFS, oInstallFolder, sTitle, N, cAddonCol

     Set oFS = CreateObject("Scripting.FileSystemObject")
     Set oInstallFolder = oFS.GetFile(WScript.ScriptFullName).ParentFolder
     Set cAddonCol = CreateObject("Scripting.Dictionary")

     N=0
     For Each oFileItem In oInstallFolder.Files
           If oFS.GetExtensionName(oFileItem.Name) = sExt Then sTitle = GetName(oInstallFolder.Path, oFileItem.Name): sFile=oFileItem.Name: cAddonCol.Add N, oFileItem.Name : N=N+1
     Next

      If N=1 Then
          Dim OF

          Set oExcel= CreateObject("Excel.Application")
          If Err.Number <> 0 Then
               Msgbox Err.Description, vbCritical, sInstalator & " " & sTitle
               Err.Clear
          Else
               Dim oFile

               For Each oF in oInstallFolder.Files
                    If oFS.FileExists(oF) And oF.Name <> oFS.GetFilename(WScript.ScriptFullName) Then oFS.CopyFile OF, oExcel.UserLibraryPath , True
               Next
               If Err.Number <> 0 Then
                    oExcel.Quit
                    Set oExcel = Nothing
                    Msgbox Err.Description, vbCritical, sInstalator & " " & sTitle
                    Err.Clear
               Else
                    Dim oWbk

                    Set oWbk = oExcel.Workbooks.add
                    oExcel.AddIns.Add (oFS.BuildPath(oExcel.UserLibraryPath, sFile)).Installed=true

                    If Err.Number <> 0 Then
                        oWbk.Close False
                        oExcel.Quit
                        Msgbox Err.Description, vbCritical, sInstalator & " " & sTitle
                        Err.Clear
                    Else
                        oWbk.Close False
                        oExcel.Quit
                        Msgbox "Installation vom Addin '" & sTitle & "' erfolgreich abgeschlossen.", vbInformation, sInstalator & " " & sTitle
                    End If
                   Set oWbk = Nothing
               End If
               Set oExcel = Nothing
          End If
     ElseIf N=0
          MsgBox "Keine Addin-Datei in diesem Folder.", vbCritical, sInstalator & " " & sTitle
     Else
          Dim key, sLista
          For Each key In cAddonCol.keys
               sLista = sLista & cAddonCol.Item(key) & vbcrlf
          Next
          MsgBox "Es gibt " & N & " Addin-Dateien in diesem Folder:" & vbcrlf & vbcrlf & Trim(sLista) & vbcrlf & _
                      "Es darf nur eine Addin-Datei im Folder sein.", vbCritical, sInstalator
     End If
     Set oFS = Nothing
     Set oInstallFolder = Nothing
     Set cAddonCol = Nothing
End If

Function GetName(sFolder, SFile)

   Dim objShell, objFolder, objFolderItem

   Set objShell = CreateObject("Shell.application")
   Set objFolder = objShell.Namespace(sFolder)
   Set objFolderItem = objFolder.ParseName(sFile)
   
    GetName = objFolder.GetDetailsOf(objFolderItem, 21)

    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Function


zamieścił: admin


12 listopada 2016

Nowe makro dziale Excel.

Makro wykorzystuje ADODB do komunikacji pomiędzy Excelem a bazą danych w Access.

zamieścił: admin


7 marca 2016

Nowe makro w dziale Excel

zamieścił: admin


28 stycznia 2016

Nowy link w dziale Linki.

zamieścił: admin


Porada 29 maja 2015
Jak wykorzystywać wyrażenia regularne (Regex) w VBA:

Option Explicit

Function GetNumber(strText As Variant, sVariable As String) As Variant

Dim oRegex As Object, oMatches As Object, oM As Object
Dim vValue As Variant

Set oRegex = CreateObject("VBScript.Regexp")

'Wynajduje liczby oraz łańcuchy tekstowe przed którymi jest nazwa zmiennej i znak równości
oRegex.Pattern = "(" & sVariable & "=" & ")" & _
    "(\d+(?:[\.\,]\d+)?|$|\s)"

'wyszukuje wszystkie ciagi znaków spelniajace warunek
oRegex.Global = True

Set oMatches = oRegex.Execute(strText)

Select Case True
    Case oMatches.Count = 1
        If oMatches(0).submatches.Count = 2 Then
            vValue = oMatches(0).submatches(1)
        Else
            vValue = ""
        End If
        
        If IsNumeric(vValue) Then GetNumber = CDbl(vValue) Else GetNumber = vValue
        
    Case oMatches.Count = 0
        GetNumber = "[#NM]"
    Case oMatches.Count > 1
        GetNumber = "[#O]"
End Select

Set oRegex = Nothing
Set oMatches = Nothing

End Function


Powyższa funkcja zwraca wartość określonej zmiennej w podanym tekście.
Jeśli w tekście występuje ciąg "Wartość X=1050" to po wywołaniu tej funkcji otrzymamy liczbę 1050.

Przykład wywołania:

Sub PodajWartosc()

   MsgBox GetNumber("Wartość X=1050", "X")

End Sub


zamieścił: admin


Porada 10 grudnia 2013
Jak przerwać działanie makra (pętli) poprzez naciśnięcie klawisza ESC

Należy do tego użyć funkcji API.
Na poziomie modułu funkcję tę trzeba zadeklarować:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer


A potem:
Do Until GetAsyncKeyState(vbKeyEscape) <> 0
     '..... tutaj operacje w pętli
     DoEvents
Loop


zamieścił: admin


23 maja 2013

Nowy link w dziale Linki.

zamieścił: admin


20 maja 2013

Nowe makro w dziale Autocad.

zamieścił: admin


1 marca 2013

Z uwagi na sprawy prywatne nie byłem w stanie zajmować się stroną vbamania.pl.
Domena przepadła - nie udało mi się jej odzyskać, więc po dwu miesiącach nieobecności najlepsza polska strona poświęcona VBA powraca w nowym wcieleniu jako Makra.VBA.
Wszelkie Wasze loginy i hasła pozostały bez zmian. Przepraszam za nieobecność i mam nadzieję, że dalej będziecie odwiedzać nasz serwis.

zamieścił: admin




<-wstecz  1 2 3 4 5 6 7 8 9 10  dalej->
wszystkich stron: 12