Thursday, May 19, 2005

Some Useful Tip for EXCEL Visual Basic

1. Suppress alerts and Screen updating
It can be annoying to have to respond to system alerts or see the screen change and flicker while a macro is running. To suppress alerts and screen updating, add following two lines at the beginning of the macro,
Application.DisplayAlerts=False
Application.ScreenUpdating=False

don't forget to add following two lines at the end of the macro,
Application.DisplayAlerts=True
Application.ScreenUpdating=True


2. Error Handling
To trap error, using following statement at the beginning of code that you anticipate error will occur, On Error GoTo errorhandling


put your code here.....
On Error GoTo 0 ' resume
errorhandling:
put your error handling code here......
3. loop statements
  • Do While (condition) ... Loop
  • Do Until (condition) ... Loop
  • For i=Startvalue TO Endvalue Step Stepvalue ... Next
  • For Each ... Next
Example of 'For Each ... Next', To get the shape name which stored in one cell.
For Each Shape In Sheets("data").Shapes
With Shape
pt = .Top
pl = .Left
If (pt >= t) And (pt <= t + h) And (pl >= l) And (pl <= l + w) Then rtnstr = Shape.Name Exit For End If End With Next Shape

4. Convert between String and Numeric
Val(String) , Convert string to numeric.
Str(Number), Convert number to string.
format(number,"format "), Convert number to string
For other type conversion functions, search 'Type Conversion Functions' in Microsoft Visual Basic Help.
5. Get Workbook's name and path
name=ActiveWorkbook.Name
path= ActiveWorkbook.Path

6. Open other excel file
Workbooks.Open (ExcelFileName)
7. Insert picture fit in a Range
' inserts a picture and resizes it to fit the TargetCells range
Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)

Dim p As Object
Dim t As Double, l As Double, w As Double, h As Double
Dim ot As Double, ol As Double, ow As Double, oh As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import pictureSet p = ActiveSheet.Pictures.Insert(PictureFileName)' determine positions
With TargetCells
t = .Top + 1
l = .Left + 1
w = .Offset(0, .Columns.Count).Left - .Left - 2
h = .Offset(.Rows.Count, 0).Top - .Top - 2
End With
' position picture
With p
oh = .Height
ow = .Width
.Top = t
.Left = l
.Width = ow * h / oh
.Height = h
.Placement = xlMoveAndSize
.PrintObject = True
End With
Set p = Nothing
End Sub

8. Wait untill called program finished
Some time in Excel VBA program, we use shell command to call other program, but by By default, the Shell function runs other programs asynchronously. This means that a program started with Shell might not finish executing before the statements following the Shell function are executed. to wait the called program finish, use following code.
first, define the calling for microsoft API
Private Declare Function OpenProcess Lib "kernel32" ( _ByVal dwDesiredAccess As Long, _ByVal bInheritHandle As Long, _ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _ByVal hProcess As Long, _IPExitCode As Long) As Long
then, write your VBA's sub or function procedure as below
Public Sub yoursub()
ACCESS_TYPE = &H400
STILL_ACTIVE = &H103
taskid = Shell(cmdline, vbHide)
hproc = OpenProcess(ACCESS_TYPE, False, taskid)
Do
Application.Wait (Now + TimeValue("0:00:01"))
GetExitCodeProcess hproc, lExitCode
Loop While lExitCode = STILL_ACTIVE
do other things....
end sub

9.Convert between string and date
dim A1 as string, outdate as date
dim ctyear as Integer, ctmonth as Integer, ctday as Integer
A1 = "20050701"
ctyear=CInt(Left(A1,4))
ctmonth=CInt(mid(a1,5,2))
ctday=CInt(right(a1,2))
outdate=DateSerial(ctyear,ctmonth,ctday)
'outdate = DateValue(Mid(A1, 5, 2) & "/" &amp;amp;amp; Right(A1, 2) & "/" & Left(A1, 4))
A1 = Format(outdate, "yyyymmdd")

10.Delete rows from title to the last row
Suppose the first tow lines are title, to delete the rows that is not title,
Dim tolcol As Integer, tolrow As Integer

Sheets("Result").Select
Selection.SpecialCells(xlCellTypeLastCell).Select
tolcol = ActiveCell.Column
tolrow = ActiveCell.Row
If (tolrow > 2) Then
Range(Cells(2, 1), Cells(tolrow, tolcol)).Select
Selection.EntireRow.Delete
End If
Range("A2").Select


11.Get last row and column of a sheet
Sheets(ssn).Select
 Selection.SpecialCells(xlCellTypeLastCell).Select
    tolcol = ActiveCell.Column
    tolrow = ActiveCell.Row


12.Find line break in cell
The line break in excel is alt+enter, is char(10). 
=FIND(CHAR(10),C439,1)
 


No comments: