theactuaryfactory.com
Home Tools Code Snippets Contact Me Links About Me
Recently, the addition of a committed replica rolex advised for acceptance rolex replica watches to watch the acute affection rate. This watch has a affection amount apprehension function, can advice sports agents rolex replica calmly get synchronized apprentice affection amount abstracts from the cloud, so as to acclimatize the training affairs rolex replica watches according to the student's affection amount level.
Skip Navigation Linksmann-jones.com -> Code Snippets   
Tools:
The Actuary Factory Excel Password Cracker [Excel/VBA] ** NEW ** Excel Process Model Android Heat Maps (web)
ScreenScraper Excel Password Cracker [C#] Cube Media Population Modeller Heat Maps (winform) File and folder Compare

Snippets

Below are a selection of code snippets I have used and developed.  Please feel free to use them.  You can normally just cut and paste the code in to a VBA module.  I have included an xls that contains the VBA/Excel code.

Download : SnippetsExample.xls

Languages : Excel/VBA

Hide and show rows
Language : VBA\Excel
Description : The code below can be used to hide and show rows.

It consists of two subs (HideRows and ShowRows) that do the hiding and showing, for example :
HideRows(10) �hides row 10
ShowRows(10) �shows row 10

Another helper sub (ShowHideRows) that hides/shows depending on a rows current state, for example :
ShowHideRows(10) -> if row is showing, it hides it and vice versa

A controller routine (HideShowButtonController) that I attached to a button in an excel sheet. In this routine developer can define what rows are shown/hidden. In the code example below it hides/shows rows from row 12 to 112, where there is an X in Column ‘C�
Sample Code:

'Helper function

Sub ShowRows(iRow As Integer)

   Rows(iRow).EntireRow.Hidden = False

End Sub 'Helper function

Sub HideRows(iRow As Integer)

   Rows(iRow).EntireRow.Hidden = True

End Sub

 

Sub ShowHideRows(iRow As Integer)

   If Rows(iRow).Hidden = True Then

      Rows(iRow).EntireRow.Hidden = False

   Else Rows(iRow).EntireRow.Hidden = True

   End If

End Sub

 

‘Public function

Public Sub HideShowButtonController()

   'Range of rows to test

   For i = 12 To 112 Step 1

      'Hide or show row depending on current status

      If ActiveSheet.Cells(i, 3).Value = "x" Then

          ShowHideRows (i)

      End If

   Next i

End Sub

 


GetNamessss
Language : VBA\Excel
Description : This code can be used to list all the named ranges/cells and their names in a workbook.
Screen shot :
Eval Screenshot
Sample Code:

Public Sub GetNames()

‘This code can be used to list all the named ranges/cells and their names in a workbook. This is then displayed to the user in a new sheet.

‘This does this by inserting a new sheet and then trolling through each Name in the workbook and pasting the name in the new ‘NamedRanges�sheet.

‘Basic error handling.

On Error GoTo errHandler

ActiveWorkbook.Sheets.Add Before:=Worksheets(1) Worksheets(1).Name = "NamedRanges"

Dim iRow As Integer

Dim iCol As Integer

iRow = 1

iCol = 1

Dim sNamer As Name

For Each sNamer In ActiveWorkbook.Names

   Worksheets("NamedRanges").Cells(iRow, iCol) = sNamer.NameLocal

   Worksheets("NamedRanges").Cells(iRow, iCol + 1) = sNamer

   iRow = iRow + 1

Next sNamer

Exit Sub

errHandler:

    MsgBox Err.Description

End Sub

 



 
EVAL
Language : VBA\Excel
Description : Evaluates a string as a function in Excel.  Uses the VBA Evaluate function.
Screen shot :
Eval Screenshot
Sample Code:
Public Function EVAL(theInput As Variant) As Variant

Dim vEval As Variant
Application.Volatile
 
On Error GoTo funcfail 

If Not IsEmpty(theInput) Then 

If TypeOf Application.Caller.Parent Is Worksheet Then   
vEval = Application.Caller.Parent.Evaluate(theInput)
Else
   
vEval = Application.Evaluate(theInput)
End If

If IsError(vEval) Then
   
EVAL = CVErr(xlErrValue)
Else
   
EVAL = vEval
End If
End If
 
Exit Function 

funcfail::    
EVAL = CVErr(xlErrNA)
End Function
 


Sample Code:
GetWorkbook, GetFilename, GetPathName, GetFullPathName, GetApplicationUser, GetFileVersion
Language : VBA\Excel
Description : An example of various functions that can be used to retrieve information about your current file, system and user.
Screen shot:
'Gets' Screenshot
Sample Code:
Public Function GetWorkbook()   
'Returns Workbook FullName   
   Get
Workbook = ActiveWorkbook.FullName
End Function 


Public Function GetFilename()
   
'
Returns Filename, same as workbook function   
   Get
Filename = ActiveWorkbook.Name
End Function 


Public Function GetPathName()
   
'Returns Workbook path   
   Get
PathName = ActiveWorkbook.path  
En
d Function 


Public Function GetFullPathName()
   
'Returns Full Workbook path (includes server), use function ConvertDrive2ServerName, as below   
  
On Error GoTo ErrorHandler          
      Get
FullPathName = ConvertDrive2ServerName(ActiveWorkbook.path)   
ErrorHandler:   
  
Pathanme = "ERROR"   
End Function
 


Public Function GetApplicationUser() As String
Application.Volatile
   On Error GoTo errHandler
      GetApplicationUser = Application.UserName
      Exit Function
errHandler:
    User = "User Not Found"
End Function


Public Function GetFileVersion(FileNameAndPath As Variant) As Variant
Application.Volatile
   On Error GoTo errHandler
      Dim fso As Variant
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set fil = fso.GetFile(FileNameAndPath)
      GetFileVersion = fso.GetFileVersion(fil)
      Exit Function
errHandler:
   GetFileVersion = "File Not Found"
End Function
 

ShowFreeSpace
Language : VBA\Excel
Description :  Shows the free space in Kb on a particular drive
Screen shot :
Sample Code:
Public Function ShowFreeSpace(drvPath)  Dim fs, d, s   
  
Set fs = CreateObject("Scripting.FileSystemObject")   
  
Set d = fs.GetDri   
 
ve(fs.GetDriveName(drvPath)) 
  
s = "Drive " & UCase(drvPath) & " - "   
  
s = s & d.VolumeName & vbCrLf      
  
s = s & "Free Space: " & FormatNumber(d.FreeSpace / 1024, 0)    
  
s = s & " Kbytes"    
  
ShowFreeSpace = s
End Function
 

Sample Code:
ConvertDrive2ServerName
Language : VBA\Excel
Description : Converts a drive name eg 'M:' to a full server name, this is particularly useful if users have mapped ther own drives.
Screen shot:
Eval Screenshot
Sample Code:
Public Function ConvertDrive2ServerName(ByVal sFullPath As String) As String
Application.Volatile
' Replaces the DriveName with ShareName in a given string
Dim fso As Variant
Dim sDrive As String
Dim drvName As Variant
Dim sShare As String
   On Error GoTo ErrorHandling
   Set fso = CreateObject("Scripting.FileSystemObject")
   sDrive = fso.GetDriveName(sFullPath)
   Set drvName = fso.GetDrive(sDrive)
   sShare = drvName.ShareName
   If LenB(sShare) <> 0 Then
      ConvertDrive2ServerName = Replace(sFullPath, sDrive, sShare, 1, 1, vbTextCompare)
   Else
      ConvertDrive2ServerName = sFullPath
   End If

   If Not fso Is Nothing Then Set fso = Nothing

' --------------------------------- ' Error Handling ' --------------------------------
ErrorHandling:
   If err <> 0 Then err.Clear
      Resume Next
   End If
End Function
 

 

To Do:

Nothing much, just for fun

Keywords:

Excel, VBA, macro, convert server name, drive, worksheet, spreadsheet, 97, 2010, 2007, 2010, cells, sheet, workbook, free space, get file name, get path, get full path, evaluate function from string, text, get user.

 

Discaimer:

This was developed for my own benefit and for fun.  It is not a commercial product and have not been thoroughly tested etc.

May 2012



copyright www.mann-jones.com (Disclaimer)