• Objects
– the
Excel application (the largest object)
– a
workbook
– a
worksheet
– a
range
– a
chart
– a
legend
• Methods
– Activate
– Clear
– Copy
– Cut
– Delete
– Select
• The
syntax of many statements in Visual Basic is
– Object.Method
– Range("B3").Select
• Properties
– ColumnWidth
– Font
– Formula
– Text
– Value
• A
property can be thought of as being somewhat similar to an adjective. It is set
using a statement of the form
– Object.Property
= value
– ActiveCell.FormulaR1C1
= "D.Morgan“
– Range("C3").ColumnWidth
= 14
• Variables
– For
example, the following statement assigns the value 34 to the variable x.
• x
= 34
– In
the example below, variables myl and myw are given initial values. These are
then used in a calculation.
• myl
= 34
• myw
= 15
• myarea
= myl*myw
• Using
Dim
– Dim
variablename As datatype
• Example
Dim Statement
• Sub
example()
• Dim myint As Integer
• myint = 5
• End
Sub
• Dim
marks, c, d
– Set
marks = Range("A1:B10")
– d
= 0
– For
Each c in marks
– If
c.Value < 40 Then
– d
= d+1
– End
If
– Next
c
Macro actions can not be reversed or undo impossible
Please take back copy of the file before you execute the macros
Sample Macro Codes: (Copy the codes to your excel VBA environment to use the macros)
Sub ShadeEveryOtherRow()
Dim Counter As Integer
'For every row in the current selection...
For Counter = 1 To Selection.Rows.Count
'If the row is an odd number (within the selection)...
If Counter Mod 2 = 1 Then
'Set the pattern to xlGray16.
Selection.Rows(Counter).Interior.Pattern = xlGray16
End If
Next
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Sub Change_FormatHeader()
ActiveSheet.PageSetup.CenterHeader = Format(Now, "MMM DD, YYYY")
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Sub Change2Uppercase()
' Loop to cycle through each cell in the specified range.
For Each x In Range("A1:A5")
' Change the text in the range to uppercase letters.
x.Value = UCase(x.Value)
Next
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Sub Proper_Case()
' Loop to cycle through each cell in the specified range.
For Each x In Range("C1:C5")
' There is not a Proper function in Visual Basic for Applications.
' So, you must use the worksheet function in the following form:
x.Value = Application.Proper(x.Value)
Next
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Sub sskformat
k = Worksheets.Count
For i = 1 To k
If Worksheets(k - i + 1).Visible Then
Worksheets(k - i + 1).Select
Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select
Range("A2").Select
Selection.Columns.AutoFit
Range("A1").Select
Selection.Columns.AutoFit
Range("C5").Select
Selection.Columns.AutoFit
Range("G4").Select
ActiveCell.FormulaR1C1 = "SSK says go"
Range("G4").Select
ActiveCell.FormulaR1C1 = "SSK says good Morning"
Range("G5").Select
End If
Next i
End Sub
'----------------------------------------------------------------------------
Sub NormalPosition()
' Select top cell for all sheets
' Visual improvement for your documents
k = Worksheets.Count
For i = 1 To k
If Worksheets(k - i + 1).Visible Then
Worksheets(k - i + 1).Select
Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next i
End Sub
'----------------------------------------------------------------------------
Sub FormulasToValues()
'
' Replace all formulas with values
'
WCount = Worksheets.Count
For i = 1 To WCount
If Worksheets(WCount - i + 1).Visible Then
Worksheets(WCount - i + 1).Select
RCount = ActiveCell.SpecialCells(xlLastCell).Row
CCount = ActiveCell.SpecialCells(xlLastCell).Column
For j = 1 To RCount
For k = 1 To CCount
Worksheets(WCount - i + 1).Cells(j, k) = Worksheets(WCount - i + 1).Cells(j, k).Value
Next k
Next j
End If
Next i
End Sub
'----------------------------------------------------------------------------
Sub DeleteHiddenSheets()
'
' Remove hidden sheets from your document
'
i = 1
While i <= Worksheets.Count
If Not Worksheets(i).Visible Then
Worksheets(i).Delete
Else
i = i + 1
End If
Wend
End Sub
'----------------------------------------------------------------------------
Sub DeleteHiddenRows()
'
' Remove hidden rows from all sheets
'
For i = 1 To Worksheets.Count
If Worksheets(i).Visible Then
Worksheets(i).Select
ActiveCell.SpecialCells(xlLastCell).Select
k = ActiveCell.Row
For j = 1 To k
If Rows(j).Hidden Then
Rows(j).Hidden = False
Rows(j).Delete
End If
Next j
End If
Next i
If Worksheets(1).Visible Then Worksheets(1).Select
End Sub
'----------------------------------------------------------------------------
Sub Combine2coulumnto3()
'Have x start at row 3
x = 3
'Loop until a blank row is found
Do While Cells(x, 3).Value <> ""
'This will put the values of the
'third and fourth columns(C and D)
'together with a space between them
'in the fifth column(E)
Cells(x, 5).Value = Cells(x, 3).Value + " " + Cells(x, 4).Value
'increase the value of x by 1
'to act on the next row
x = x + 1
Loop
End Sub
'----------------------------------------------------------------------------
Sub Setbackgroundcolorrange()
'Tell VBA that the MyCell variable is a range
Dim MyCell As Range
For Each MyCell In Selection
If MyCell.Value Like "*Book*" Then
'Set the Cell Background color to green
MyCell.Interior.ColorIndex = 4
ElseIf MyCell.Value = " " Then
'Clear the cell back ground color
MyCell.Interior.ColorIndex -xlNone
Else
'Set the cell background color to blue
MyCell.Interior.ColorIndex = 5
End If
Next
End Sub
'----------------------------------------------------------------------------
Sub Deleteduplicate()
'Loop to delete duplicates - nested loops
'Start at the currently selected cell
x = ActiveCell.Row
y = x + 1
Do While Cells(x, 4).Value <> ""
Do While Cells(y, 4).Value <> ""
'Test for duplication;
'If the values of the fourth column (D)
'and the sixth column (F) match in
'two rows, delete the second row of the pair
'otherwise go to the next row until the end
If (Cells(x, 4).Value = Cells(y, 4).Value) And (Cells(x, 6).Value = Cells(y, 6).Value) Then
Cells(y, 4).EntireRow.Delete
Else
y = y + 1
End If
Loop
'increase the value of x by 1 to move
'the loop starting point to the next row
x = x + 1
'reset y so it start at the next row
y = x + 1
Loop
End Sub
'----------------------------------------------------------------------------
Excel Macro Basics Reference Book
'----------------------------------------------------------------------------
Sub NormalPosition()
' Select top cell for all sheets
' Visual improvement for your documents
k = Worksheets.Count
For i = 1 To k
If Worksheets(k - i + 1).Visible Then
Worksheets(k - i + 1).Select
Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next i
End Sub
'----------------------------------------------------------------------------
Sub FormulasToValues()
'
' Replace all formulas with values
'
WCount = Worksheets.Count
For i = 1 To WCount
If Worksheets(WCount - i + 1).Visible Then
Worksheets(WCount - i + 1).Select
RCount = ActiveCell.SpecialCells(xlLastCell).Row
CCount = ActiveCell.SpecialCells(xlLastCell).Column
For j = 1 To RCount
For k = 1 To CCount
Worksheets(WCount - i + 1).Cells(j, k) = Worksheets(WCount - i + 1).Cells(j, k).Value
Next k
Next j
End If
Next i
End Sub
'----------------------------------------------------------------------------
Sub DeleteHiddenSheets()
'
' Remove hidden sheets from your document
'
i = 1
While i <= Worksheets.Count
If Not Worksheets(i).Visible Then
Worksheets(i).Delete
Else
i = i + 1
End If
Wend
End Sub
'----------------------------------------------------------------------------
Sub DeleteHiddenRows()
'
' Remove hidden rows from all sheets
'
For i = 1 To Worksheets.Count
If Worksheets(i).Visible Then
Worksheets(i).Select
ActiveCell.SpecialCells(xlLastCell).Select
k = ActiveCell.Row
For j = 1 To k
If Rows(j).Hidden Then
Rows(j).Hidden = False
Rows(j).Delete
End If
Next j
End If
Next i
If Worksheets(1).Visible Then Worksheets(1).Select
End Sub
'----------------------------------------------------------------------------
Sub Combine2coulumnto3()
'Have x start at row 3
x = 3
'Loop until a blank row is found
Do While Cells(x, 3).Value <> ""
'This will put the values of the
'third and fourth columns(C and D)
'together with a space between them
'in the fifth column(E)
Cells(x, 5).Value = Cells(x, 3).Value + " " + Cells(x, 4).Value
'increase the value of x by 1
'to act on the next row
x = x + 1
Loop
End Sub
'----------------------------------------------------------------------------
Sub Setbackgroundcolorrange()
'Tell VBA that the MyCell variable is a range
Dim MyCell As Range
For Each MyCell In Selection
If MyCell.Value Like "*Book*" Then
'Set the Cell Background color to green
MyCell.Interior.ColorIndex = 4
ElseIf MyCell.Value = " " Then
'Clear the cell back ground color
MyCell.Interior.ColorIndex -xlNone
Else
'Set the cell background color to blue
MyCell.Interior.ColorIndex = 5
End If
Next
End Sub
'----------------------------------------------------------------------------
Sub Deleteduplicate()
'Loop to delete duplicates - nested loops
'Start at the currently selected cell
x = ActiveCell.Row
y = x + 1
Do While Cells(x, 4).Value <> ""
Do While Cells(y, 4).Value <> ""
'Test for duplication;
'If the values of the fourth column (D)
'and the sixth column (F) match in
'two rows, delete the second row of the pair
'otherwise go to the next row until the end
If (Cells(x, 4).Value = Cells(y, 4).Value) And (Cells(x, 6).Value = Cells(y, 6).Value) Then
Cells(y, 4).EntireRow.Delete
Else
y = y + 1
End If
Loop
'increase the value of x by 1 to move
'the loop starting point to the next row
x = x + 1
'reset y so it start at the next row
y = x + 1
Loop
End Sub
'----------------------------------------------------------------------------
Excel Macro Basics Reference Book
No comments:
Post a Comment