microsoft
Todo for Excel 2010/Snippets/Worksheet: edit · history · watch · refresh
  1. Implement into a VSTO library for general Use.

Macros


'=================================================================================
'- CHECK IF A MODULE & SUBROUTINE EXISTS
'- VBA constant : vbext_pk_Proc = All procedures other than property procedures.
'- An error is generated if the Module or Sub() does not exist - so we trap them.
'---------------------------------------------------------------------------------
'- VB Editor : Tools/References - add reference TO ......
'-    .... "Microsoft Visual Basic For Applications Extensibility"
'----------------------------------------------------------------------------------
'- Brian Baulsom October 2007
'- http://www.cpearson.com/excel/vbe.aspx
'==================================================================================
Function MacroExists(ws As Worksheet, proc As String) As Boolean
   Dim cmod As VBIDE.CodeModule
   Dim num As Long   'max lines in a codemodule
   Dim procname As String
   Dim curwb As Workbook: Set curwb = ws.Parent
   
On Error Resume Next
   Set cmod = curwb.VBProject.VBComponents(ws.CodeName).CodeModule
On Error GoTo 0

   num = cmod.CountOfDeclarationLines + 1
   
         
   Do Until num >= cmod.CountOfLines
      procname = cmod.ProcOfLine(num, VBIDE.vbext_pk_Proc)
      num = cmod.ProcStartLine(procname, vbext_pk_Proc) + cmod.ProcCountLines(procname, vbext_pk_Proc) + 1
      
      If procname = proc Then
         MacroExists = True
         Exit Function
      End If
   Loop

   MacroExists = False
End Function


UniqueValues


'@ws - Worksheet Object
'@col - String value, The Column Range value to be searched for Unique Values.
'Notes:
'   - @col should ideally be a single column/row to have Values looked at for Cingularity.
Function UniqueValues(ws As Worksheet, col As String) As Variant
   
   Dim rng As Range: Set rng = ws.Range(col)
   Dim dict As New Scripting.Dictionary
   
   If Not (rng Is Nothing) Then
      Dim cell As Range, val As String
      
      For Each cell In rng.Cells
         val = CStr(cell.Value)
         
         If Not dict.Exists(val) Then
            dict.Add val, val
         End If
         
      Next cell
   End If
      
   'Return value
   UniqueValues = dict.Items
End Function


Protections


'Enables/Unprotects a Worksheet
'@ws - Worksheet Object
'Returns: XlEnableSelection value
'Notes:
'   - Makes a Worksheet Editable/Unprotected to operate with.
'   - Returns XlEnableSelection value for state retention for later lock-down.
Function EnableSelect(ws As Worksheet) As XlEnableSelection
   Dim ret As XlEnableSelection
   ret = ws.EnableSelection
   
   ws.EnableSelection = xlNoRestrictions
   
   EnableSelect = ret
End Function



'Disables/Protects a Worksheet
'@ws - Worksheet Object
'@sel - XlEnableSelection value
'Notes:
'   - @sel is the return value from "EnableSelect"
Sub DisableSelect(ws As Worksheet, sel As XlEnableSelection)
   ws.EnableSelection = sel
End Sub



References

  1. Brian Baulsom (October 2007). "Programming In The VBA Editor".