Excel vba编程实例 源码

来源:互联网 发布:淘宝举报需不需要登录 编辑:程序博客网 时间:2024/05/01 20:40
 
Private Sub CommandButton1_Click()

'AddOne
'AddNew
'FourthOne
Worksheets("Sheet2").Activate
'SeveralRows

'ClearRange
'SetValue
'EnterValue
CycleThrough
End Sub

Sub AddOne()
Workbooks.Add
End Sub
Sub AddNew()
Set newBook = Workbooks.Add
With newBook
.Title = "1995 Sales"
.Subject = "Sales"
.SaveAs Filename:="95Sales.xls"
End With
End Sub
Sub FourthOne()
'AddOne
'Sheets(3).Activate
'Charts(1).Activate
'Charts("Chart1").Activate
'ActiveWorkbook.SaveAs _
'Filename:="E:/myfile.htm", _
'FileFormat:=xlHtml
'ChartObjects(1).Activate
'With Application.DefaultWebOptions
'.RelyOnVML = True
'.AllowPNG = True
'.PixelsPerInch = 96
'End With

'With ActiveWorkbook
'.WebOptions.AllowPNG = False
'With .PublishObjects("Chart3")
'.Filename = "E:/1998_Q1.htm"
'.Publish
'End With
'End With

End Sub

Sub SeveralRows()
Worksheets("Sheet2").Activate
Dim worksheettemp As Worksheet
Set worksheettemp = Worksheets("Sheet2")
Dim myUnion As Range
Set myUnion = Union(worksheettemp.Rows(1), worksheettemp.Rows(2), worksheettemp.Rows(5))
myUnion.Font.Bold = True
End Sub
Sub ClearRange()
Worksheets("Sheet2").[A1:B5].ClearContents
End Sub
Sub SetValue()
Dim MyRange As Range
Set MyRange = Worksheets("Sheet2").[A1:B5]
MyRange.Value = 10
End Sub
Sub EnterValue()
Worksheets("Sheet2").Cells(6, 1).Value = 10
End Sub
Sub CycleThrough()
Dim counter As Integer
For counter = 1 To 20
Worksheets("Sheet2").Cells(counter, 3).Value = counter
Next counter
End Sub