DOC

VBA Note

By Dan Phillips,2014-06-16 10:33
7 views 0
VBA Note

筆記 :

(1)-自定義 f(x)

     Function Addtwo (arg1,arg2)

     Addtwo = arg1 + arg2

     End Function

(2)-細節寫法

     (A) Application.Workbooks("Book1.xls").Worksheets("Sheet1").Range

    ("A1").value

     (B) ListBox1.RowSource = "[Book2.xls]Sheet1!a1:a8"

(3)-IF + Msgbox ( VbYesNo )用法

     Private Sub CommandButton1_Click()

     Msg = "Is your name " & Application.UserName & "?"

     Ans = MsgBox(Msg, vbYesNo)

     If Ans = vbNo Then MsgBox "Oh, never mind."

     If Ans = vbYes Then MsgBox "Yes, I must be psychic !"

     End Sub

(4)-Not 用法

     ActiveWindow.DisplayGridlines = _

     Not ActiveWindow.DisplayGridlines

(5)-儲存格表示方式 (Range,Cell)

     長寫

     (A) Range("b8").Value = Range("b2").Value

     (B) [b8].Value = [b2].Value

     (C) Cells(8, 2).Value = Cells(2, 2).Value

     簡寫

     (a) Range("b8") = Range("b2")

     (b) [b8] = [b2]

     (c) Cells(8, 2) = Cells(2, 2)

     (d) Range("D:D,Z:Z") = Range("D:D"),Range("Z:Z")

     實例 (x)=(y)

     (x) Range("A1,J10").value=99

     (y) Range(Cell(1,1),cells(10,10)).value=Range("A1,J10").value=99

(6)-命令集

     (A)數工作Book :

     MsgBox Workbooks.Count

     (B)儲存格格式出現 / :

     ActiveWindow.DisplayGridlines = True

     (C)只清除 A1 內容 :

     Range("A1").ClearContents

     (D)全部清除 A1 包活 : 內容 + 格式

     Range("A1").Clear

     (E)復制 抄取 : 包活 : 內容 + 格式

     Worksheets("Sheet1").Activate

     Range("A1").Copy Range("B1")

     (F)開新的工作簿

     Workbooks.Add

     (G)建立InputBox

     Private Sub CommandButton1_Click()

     Num = InputBox(" Enter a positive Number")

     MsgBox = Num ^ (1 / 3) & " is the cube root."

     End Sub

     (H)任意格生成指定資料

     Private Sub CommandButton1_Click()

     ActiveCell.FormulaR1C1 = "Jan"

     ActiveCell.Offset(0, 1).Range("A1").Select

     ActiveCell.FormulaR1C1 = "Feb"

     ActiveCell.Offset(0, 1).Range("A1").Select

     ActiveCell.FormulaR1C1 = "Mar"

     ActiveCell.Offset(0, 2).Range("A1").Select

     End Sub

     (I)Offset

     Range("C2").Offset(-1,-2)

     (J)引用行,,範圍

     Columns("A:C") , Row("1:5")

     MsgBox Sheets("Sheet1").Range("F3").Row --> 3

     MsgBox Sheets("Sheet1").Range("F3").Columns --> 6

     MsgBox Range("A1:C3").Count --> 9

     MsgBox Range(Cell(1,1),cells(5,5)).Address --> $A$1:$E$5

     Sheets("Sheet1").Activate --> 當前活頁

     (k)數字符

     AA = Len("df1.") --> 5

     (l)讀取File當前 容量 Byte

     AA = "C:\Book1.xls"

    >123 MsgBox FileLen(AA) --

     (m)讀取整數

     AA= Fix(123.456)

     MsgBox (AA) -->123

     (n)讀取Combobox List 對應的 Item

     TextBox1 = ComboBox1.List(ComboBox1.ListIndex, 2)

     *請意取後的2, a,b,c, 2 則指 c, 因為基準不計算在內

     (O)打取儲存格資料

     Range("A1:A5").Copy Range("B1")

     (P)當前上下左右選取 (xlUp,xlDown,XlToLeft,XlRight)

     Range(ActiveCell, ActiveCell.End(xlDown)).Select

     (Q)加快及刷身

     Application.ScreenUpdating = False / True (要返回True)

     Application.Calculation = xlCalculationManual '--- 手動

     Application.Calculation = xlCalculationAutomatic '--- 自動

(7)-邏輯語句

     Not = Preforms a logical negation on an expression.

     And = Preforms a logical conjunction on two expressions.

     Or = Preforms a logical disjunction on two expressions. <> XoR = Preforms a logical exclusion on two expression. = Eqv = Preforms a logical equivalence on two expression. Like Imp = Preforms a logical Implication on two expression.

(8)-GoTo 用法

     Private Sub CommandButton1_Click()

     UserName = InputBox("Enter Your Name : ")

     If UserName <> "StanleyLam" Then GoTo Error

     MsgBox ("Welcom StanleyLam Login")

     '.... [Desgin Code For Yourself...

     Exit Sub

     Error:

     MsgBox " Sorry , Only StanleyLam Login Here "

     End Sub

(9)-If & Case & Do while... Loop 用法

     (A) If 條件1 then

     語句1

     else 條件2 then

     語句2

     else 條件3 then

     語句3

     End if

     (B) Sub Case01()

     Qty= Inputbox("Enter Quantity")

     Select Case Qty

     Case 0 To 24

     Discount = 0.1

     Case 25 To 49

     Discount = 0.15

     Case 50 To 74

     Discount = 0.2

     Case is >=75

     Discount = 0.25

     End Select

     Msgbox "Rate : " & Discount

     End Sub

     (C) Sub Case02()

     Qty= Inputbox("Enter Quantity")

     Select Case Qty

     Case 0 To 24 :Discount = 0.1

     Case 25 To 49:Discount = 0.15

     Case 50 To 74:Discount = 0.2

     Case is >=75 :Discount = 0.25

     End Select

     Msgbox "Rate : " & Discount

     End Sub

     (D) Sub Do_WhileLooop() '有數就一路向下每數*2

    Do While ActiveCell.Value <> Empty

     ActiveCell.Value = ActiveCell.Value * 2

     ActiveCell.Offset(1, 0).Select

     Loop

     End Sub

     格式一: Do [While 條件]

     [執行語句1]

     [Exit Do]

     [執行語句2]

     Loop

     Sub DoLoopUntilDemo()

     Do

     ActiveCell.Value = ActiveCell.Value * 2

     ActiveCell.Offset(1, 0).Select

     Loop Until IsEmpty(ActiveCell.Value)

     End Sub

     格式二: Do

     [執行語句1]

     [執行語句2]

     Loop [Until 條件]

     (E) For Each 做法

     Sub ForEach01()

     Dim Cell As Range

     For Each Cell In Range("A1:E50")

     If Not Cell.HasFormula Then

     If IsNumeric(Cell.Value) Then

     Cell.Value = Cell.Value * -1

     End If

     End If

     Next

     End Sub

     Sub ForEach02()

     Dim WkSht As Worksheet

     For Each Wksht In Activeworkbook.worksheets

     WkSht.Rows(1).Delets

     Next Wksht

     End Sub

     格式 : For Each element in collection

     [statements]

     [Exit For]

     [statements]

     Next [element]

     (F) 關閉前要另存BackUp

     Private Sub Workbook_BeforeClose(Cancel As Boolean)

     Dim Msg As String

     Dim Ans As Integer

     Dim Fname As String

     Msg = "Would you like to make a backup of this file ?"

     Ans = MsgBox(Msg, vbYesNo)

     If Ans = vbYes Then

     Fname = "F:\Backup\" & ThisWorkbook.Name

     ThisWorkbook.SaveCopyAs Fname

     End If

     End Sub

     (G) On Error 做法

     Sub EnterSquareRoot6()

     Dim Num As Variant

     Dim Msg As Integer

     Dim Ans As Integer

     TryAgain:

     On Error GoTo BadEntry

     Num = InputBox("Enter a value")

     If Num = "" Then Exit Sub

     ActiveCell.Value = Sqr(Num)

     Exit Sub

     BadEntry:

     Msg = Err.Number & ":" & Error(Err.Number)

     Msg = Msg & vbNewLine & vbNewLine

     Msg = Msg & "Make sure a range is selected, "

     Msg = Msg & "the sheet is not protected, "

     Msg = Msg & "and you enter a nonnegative value."

     Msg = Msg & vbNewLine & vbNewLine & vbNewLine & "try again?"

     If Ans = vbYes Then Resume TryAgain

     End Sub

     (H) To GetOpenFilename Method

     定義: All Files (*.*),*.*

     定義: Object.GetOpenFilename

    ([fileFilter],[filterIndex],[titel],[ButtonText],[multiSelect])

     Sub GetImportFileName()

     Dim FInfo As String

     Dim FilterIndex As Integer

     Dim Titel As String

     Dim FileName As Variant

     ' Set up List of file filters

     FInfo = "All File (*.*),*.*,Text Files (*.txt),*.txt,Excel File

    (*.xls),*.xls,Word File (*.doc),*.doc,"

     ' DIsplay *.* by default

     FilterIndex = 5

     ' Set the dialog box caption

     Title = "Select a file to import"

     ' Get the filename

     FileName = Application.GetOpenFilename(FInfo, _

     FilterIndex, Title)

     ' Handle retuen info from dialog box

     If FileName = False Then

     MsgBox "No file was selected"

     Else

     MsgBox " You selected " & FileName

     Workbooks.Open FileName

     End If

     End Sub

     (I) To GetSaveAsFilename Method

     定義: Object.GetSaveAsFilename

    ([InitialFilename],[FileFilter],[FilterIndex],[Title],[ButtonText])

     Sub GetImportFileName()

     Dim FInfo As String

     Dim FilterIndex As Integer

     Dim Titel As String

     Dim FileName As Variant

     ' Set up List of file filters

     FInfo = "All File (*.*),*.*,Text Files (*.txt),*.txt,Excel File

    (*.xls),*.xls,Word File (*.doc),*.doc,"

     ' DIsplay *.* by default

     FilterIndex = 5

     ' Set the dialog box caption

     Title = "Select a file to import"

     ' Get the filename

     FileName = Application.GetOpenFilename(FInfo, _

     FilterIndex, Title)

     ' Handle retuen info from dialog box

     If FileName = False Then

     MsgBox "No file was selected"

     Else

     MsgBox " You selected " & FileName

     Workbooks.Open FileName

     End If

     End Sub

     (J) Userform1制做大,,Proper寫法

     Private Sub OKButton_Click()

     Dim WorkRange As range

     ' Process only text cells, no formulas

     On Error Resume Next

     Set WorkRange = Selection.SpecialCells _

     (xlCellTypeConstants, xlCellTypeConstants)

     ' Upper Case

     If OptionUpper Then

     For Each Cell In WorkRange

     Cell.Value = UCase(Cell.Value)

     Next Cell

     End If

     ' Lower Case

     If OptionLower Then

     For Each Cell In WorkRange

     Cell.Value = LCase(Cell.Value)

     Next Cell

     End If

     ' Proper Case

     If OptionProper Then

     For Each Cell In WorkRange

     Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)

     Next Cell

     End If

     Unload UserForm1

     End Sub

<<實戰內容>>

    --------------------------------------------------------------------------------------

1)ListView1 DblClick UserForm2資料

    '----------------------------------------

Private Sub ListView1_DblClick()

     If Not ListView1.SelectedItem Is Nothing Then

     UserForm2.Label1.Caption = ListView1.SelectedItem.Text

     UserForm2.Show

     Else

     End If

End Sub

2)ListView1 Click UserForm2資料

    '----------------------------------------- Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

     UserForm2.Label1.Caption = Item

     'UserForm2.Label2.Caption = Item.ListSubItems(1) '(Item)

Report this document

For any questions or suggestions please email
cust-service@docsford.com