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
Public Function GetFileNameFromFullPath( _
sFullFileNameWithPath As String _
) As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
GetFileNameFromFullPath = _
fs.GetFilename( _
sFullFileNameWithPath _
)
End Function
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