In my VBA project, on common UserForms, I have three labels with click event handlers attached:
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.
Running GitHub in Edge Browser, screenshots can be pasted directly into the Comments section when submitting Issues.
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
Public Function GetBaseName( _
sFullFileNameWithExtension As String _
)
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
GetBaseName = _
fs.GetBaseName( _
sFullFileNameWithExtension _
)
Set fs = Nothing
End Function
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
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
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
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
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
Public Sub DeleteHiddenSourceColumnsFromTarget( _
rngSource As Range, _
rngTarget As Range _
)
Dim _
rngColumn As Range, _
intSourceColumnInitialOffset As Integer, _
intSourceRowInitialOffset As Integer, _
iColumn As Integer
With rngSource.Cells(1, 1)
intSourceColumnInitialOffset = .Column
intSourceRowInitialOffset = .Row
End With
For iColumn = rngSource.Columns.Count To 1 Step -1
If rngSource.Columns(iColumn).Hidden Then
rngTarget.Columns(iColumn).Delete
End If
Next iColumn
End Sub
Public Function Ellipsize( _
strInput As String, _
Optional MaxLength As Integer = 16 _
) As String
If Len(strInput) > MaxLength Then
Ellipsize = Left(strInput, MaxLength) & Chr(133)
Else
Ellipsize = strInput
End If
End Function