Option Explicit

Category: Code

  • GetFilePath

    —

    by

    Keith
    in , , ,

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

  • GetFileNameFromFullPath

    —

    by

    Keith
    in , , ,

    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

    —

    by

    Keith
    in , , ,

    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

    —

    by

    Keith
    in , , ,

    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…

  • TrimRange

    TrimRange

    —

    by

    Keith
    in , , ,

    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 -…

  • VBComponentNameIsUnique

    VBComponentNameIsUnique

    —

    by

    Keith
    in , , ,

    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

    —

    by

    Keith
    in , , ,

    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( _…

  • SlicerCount

    SlicerCount

    —

    by

    Keith
    in , , ,

    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…

  • DeleteHiddenSourceColumnsFromTarget

    DeleteHiddenSourceColumnsFromTarget

    —

    by

    Keith
    in , , ,

    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…

  • Ellipsize

    Ellipsize

    —

    by

    Keith
    in , , ,

    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