vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest czwartek, 20 czerwca 2024 roku.
Ustaw jako stronę startową Ulubione Napisz
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


17 lipca 2012

Nowe makro w dziale AutoCAD.

Makro powstało jako odpowiedź na pytanie na niemieckim forum dyskusyjnym www.cad.de, dlatego też interfejs użytkownika jest w języku niemieckim.

zamieścił: admin




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