Fandom

Microsoft Wikia

Excel 2010/Snippets/Worksheet

< Excel 2010 | Snippets

860pages on
this wiki
Add New Page
Talk0 Share
Todo for Excel 2010/Snippets/Worksheet: edit · history · watch · refresh
  1. Implement into a VSTO library for general Use.

Macros

  • Check to see if a Macro Exists in CodeModule of a Worksheet.[1]

'=================================================================================
'- 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

  • Returns a Variant Array of values that are unique to the specified Range @col.

'@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 access to the Worksheet, effectively turning the Protections off.

'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 access to the Worksheet, effectively turning Protections On

'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". http://www.cpearson.com/excel/vbe.aspx. 

Ad blocker interference detected!


Wikia is a free-to-use site that makes money from advertising. We have a modified experience for viewers using ad blockers

Wikia is not accessible if you’ve made further modifications. Remove the custom ad blocker rule(s) and the page will load as expected.