Option Explicit

Category: Distribution

  • DeleteVBACodeFromWorkbook

    Sub DeleteVBACodeFromWorkbook( _
    wb As Workbook _
)
    Dim _
        vbc As VBComponent
    For Each vbc In wb.VBProject.VBComponents
        If vbc.Type <> vbext_ct_Document Then
            wb.VBProject.VBComponents.Remove vbc
        End If
    Next vbc
End Sub

  • GetFilePath

    Public Function GetFilePath( _
    sFullFileNameWithPath As String _
) As String
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetFilePath = _
        fs.GetAbsolutePathName( _
            sFullFileNameWithPath _
        )
End Function

  • Edge, Git and VS Code Integration

    In my VBA project, on common UserForms, I have three labels with click event handlers attached:

    Utility Button Set

    First is a pause button, which just triggers a Stop command, launching the debugger/VBA IDE.

    Second is a save button, which will save ThisWorkbook.

    Third triggers the ExportModules procedure.

    Source file updates are reflected in VS Code.

    VS Code Git Updates

    Running GitHub in Edge Browser, screenshots can be pasted directly into the Comments section when submitting Issues.

  • GetFileNameFromFullPath

    Public Function GetFileNameFromFullPath( _
    sFullFileNameWithPath As String _
) as String
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetFileNameFromFullPath = _
        fs.GetFilename( _
            sFullFileNameWithPath _
        )
    Set fs = Nothing
End Function

  • GetBaseName

    Public Function GetBaseName( _
    sFullFileNameWithExtension As String _
)
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetBaseName = _
        fs.GetBaseName( _
            sFullFileNameWithExtension _
        )
    Set fs = Nothing
End Function
  • TransferFontProperties

    TransferFontProperties

    Public Sub TransferFontProperties( _
    rngSource As Range, _
    rngTarget As Range _
)
    Dim sf As Font
    Set sf = rngSource.Font
    With rngTarget.Font
        .Name = sf.Name
        .Size = sf.Size
        .Strikethrough = sf.Strikethrough
        .Superscript = sf.Superscript
        .Underline = sf.Underline
        .Color = sf.Color
        .Italic = sf.Italic
        .TintAndShade = sf.TintAndShade
        .Subscript = sf.Subscript
        .Bold = sf.Bold
    End With
End Sub
  • TrimRange

    TrimRange

    Public Function TrimRange( _
    rngSource As Range, _
    Optional TrimTop As Integer = 0, _
    Optional TrimBottom As Integer = 0, _
    Optional TrimLeft As Integer = 0, _
    Optional TrimRight As Integer = 0 _
) As Range
    Set TrimRange = _
        rngSource.Offset( _
            rowoffset:=TrimTop, _
            columnoffset:=TrimLeft _
        ).Resize( _
            rngSource.Rows.Count - TrimTop - TrimBottom, _
            rngSource.Columns.Count - TrimLeft - TrimRight _
        )
End Function
  • VBComponentNameIsUnique

    VBComponentNameIsUnique

    Public Function VBComponentNameIsUnique( _
    wb As Workbook, _
    strInputName As String _
) As Boolean
    Dim vbc As VBComponent
    VBComponentNameIsUnique = True
    For Each vbc In wb.VBProject.VBComponents
        If vbc.Name = strInputName Then
            VBComponentNameIsUnique = False
        End If
    Next vbc
End Function
  • MatchesPattern

    MatchesPattern

    Public Function MatchesPattern( _
    strInputTest As String, _
    strInputPattern As String, _
    Optional IgnoreCase As Boolean = True, _
    Optional IsGlobal As Boolean = True _
) As Boolean
    On Error GoTo Catch
    Dim objRegExp As New RegExp
    Set objRegExp = Nothing
    objRegExp.IgnoreCase = IgnoreCase
    objRegExp.Global = IsGlobal
    objRegExp.Pattern = strInputPattern
    MatchesPattern = objRegExp.Test( _
        strInputTest _
    )
    Set objRegExp = Nothing
    Exit Function
Catch:
    Set objRegExp = Nothing
End Function
  • SlicerCount

    SlicerCount

    Public Function SlicerCount( _
    scl As SlicerCacheLevel, _
    Optional NonBlankOnly As Boolean = True, _
    Optional Verbose As Boolean = True _
)
    Dim si As SlicerItem
    Dim iCount As Integer
    Dim iVerboseCount As Integer
    Dim iTotal As Integer
    iCount = 0
    If Verbose Then
        iVerboseCount = 0
        iTotal = scl.SlicerItems.Count
    End If
    For Each si In scl.SlicerItems
        If NonBlankOnly Then
            If SlicerItemIsPopulated(si) Then
                iCount = iCount + 1
            End If
        Else
            iCount = iCount + 1
        End If
        If Verbose Then
            iVerboseCount = iVerboseCount + 1
            Application.StatusBar = _
                "Counting Slicer Items (" & _
                Pct( _
                    iVerboseCount, _
                    iTotal _
                ) & _
                " complete)..."
        End If
    Next si
    SlicerCount = iCount
    If Verbose Then
        Application.StatusBar = False
    End If
End Function