Excel VBA 共五章学习实例(第1、2、6、7、9章)实用VBA源代码(7)

2018-12-20 10:22

Then

.Visible = True

.Top = Selection.Top .Left = Selection.Left

.Height = Selection.Height .Width = Selection.Width

If Target.Cells(1, 1) <> \

.Value = Target.Cells(1, 1).Value Else

.Value = Date End If Else

.Visible = False End If End With End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 And Target.Column = 1 Or Target.MergeCells Then If Target.Cells(1, 1).Value = \ DTPicker1.Visible = False End If End If End Sub

Private Sub DTPicker1_CloseUp()

ActiveCell.Value = Me.DTPicker1.Value Me.DTPicker1.Visible = False End Sub

范例87 使用spreadsheet控件

Private Sub UserForm_Initialize() Dim r As Integer Dim arr As Variant Dim i As Integer With Sheet3

r = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range(\ End With

With Me.Spreadsheet1

.DisplayToolbar = False

.DisplayWorkbookTabs = False

.DisplayHorizontalScrollBar = False .DisplayVerticalScrollBar = True .Rows.RowHeight = 15

.Columns.ColumnWidth = 8 With .Range(\ .Value = arr

.HorizontalAlignment = -4108

.Borders.LineStyle = xlContinuous .Borders.ColorIndex = 10 .NumberFormat = \ End With End With End Sub

Private Sub CommandButton1_Click() Dim r As Integer Dim arr As Variant With Me.Spreadsheet1

r = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range(\

Sheet1.Range(\ End With Unload Me End Sub

Sub RegWriteProc() Dim WshShell

Set WshShell = CreateObject(\

WshShell.RegWrite \\

Set WshShell = Nothing End Sub

1, 1,

范例88 使用TreeView控件显示层次

Private Sub UserForm_Initialize() Dim c As Integer Dim r As Integer Dim rng As Variant

rng = Sheet2.UsedRange With TreeView1

.Style = tvwTreelinesPlusMinusPictureText .LineStyle = tvwRootLines .CheckBoxes = False With .Nodes .Clear

.Add Key:=\科目\科目名称\

For c = 1 To Sheet2.UsedRange.Columns.Count For r = 2 To Sheet2.UsedRange.Rows.Count If Not IsEmpty(rng(r, c)) Then If c = 1 Then

.Add relative:=\科目\Relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c)

ElseIf Not IsEmpty(rng(r, c - 1)) Then

.Add relative:=rng(r, c - 1), Relationship:=tvwChild, Key:=rng(r, c), 32

Text:=rng(r, c)

Else .Add relative:=CStr(Sheet2.Cells(r, Relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c)

End If End If Next Next End With End With End Sub

c - 1).End(xlUp)),

Private Sub TreeView1_DblClick() Dim r As Integer With Sheet1

r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 If TreeView1.SelectedItem.Children = 0 Then

.Range(\ Else

MsgBox \您所选择的不是末级科目,请重新选择!\ End If End With End Sub

范例89 使用Listview控件

89-1 使用Listview控件显示数据列表

Private Sub UserForm_Initialize() Dim Itm As ListItem Dim r As Integer Dim i As Integer Dim c As Integer

r = Cells(Rows.Count, 1).End(xlUp).Row With ListView1

.ColumnHeaders.Add , , \人员编号 \ .ColumnHeaders.Add , , \技能工资 \ .ColumnHeaders.Add , , \岗位工资 \ .ColumnHeaders.Add , , \工龄工资 \ .ColumnHeaders.Add , , \浮动工资 \ .ColumnHeaders.Add , , \其他 \ .ColumnHeaders.Add , , \应发合计\ .View = lvwReport .Gridlines = True For i = 2 To r

Set Itm = .ListItems.Add()

Itm.Text = Space(2) & Cells(i, 1) For c = 1 To 6

Itm.SubItems(c) = Format(Cells(i, c + 1), \

Next Next End With

Set Itm = Nothing End Sub

89-2 在Listview控件中使用复选框

Private Sub UserForm_Initialize() Dim Itm As ListItem Dim r As Integer Dim i As Integer Dim c As Integer

r = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row With ListView1

.FullRowSelect = True .CheckBoxes = True For i = 2 To r - 1

Set Itm = .ListItems.Add() Itm.Text = Sheet2.Cells(i, 1) For c = 1 To 6

Itm.SubItems(c) = Format(Sheet2.Cells(i, c + 1), \ Next Next End With

Set Itm = Nothing End Sub

Private Sub CommandButton1_Click() Dim r As Integer Dim i As Integer Dim c As Integer

r = Cells(Rows.Count, 1).End(xlUp).Row

If r > 1 Then Range(\ With ListView1

For i = 1 To .ListItems.Count If .ListItems(i).Checked Then

Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = .ListItems(i) For c = 1 To 6

Cells(Rows.Count, c + 1).End(xlUp).Offset(1, 0) = .ListItems(i).SubItems(c) Next End If

Next End With End Sub

89-3 调整Listview控件的行距

Private Sub UserForm_Initialize() Dim Itm As ListItem Dim i As Integer Dim c As Integer

Dim Img As ListImage With ListView1

.FullRowSelect = True

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Set Itm = .ListItems.Add()

Itm.Text = Space(2) & Cells(i, 1) For c = 1 To 6

Itm.SubItems(c) = Format(Cells(i, c + 1), \ Next Next

Set Img = ImageList1.ListImages.Add _

(Picture:=LoadPicture(ThisWorkbook.Path & \ .SmallIcons = ImageList1 End With

Set Itm = Nothing Set Img = Nothing End Sub

89-4 在Listview控件中排序

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) With ListView1 .Sorted = True

.SortOrder = (.SortOrder + 1) Mod 2 .SortKey = ColumnHeader.Index - 1 End With End Sub

89-5 Listview控件的图标设置

Private Sub UserForm_Initialize()

共8页:

Excel VBA 共五章学习实例(第1、2、6、7、9章)实用VBA源代码(7).doc 将本文的Word文档下载到电脑下载失败或者文档不完整，请联系客服人员解决！

下载这篇word文档