没有合适的资源？快使用搜索试试~ 我知道了~

文库首页存储MicrosoftExcel VBA_控件实例集锦.doc

Excel VBA_控件实例集锦.doc

1.该资源内容由用户上传，如若侵权请联系客服进行举报
2.虚拟产品一经售出概不退款（资源遇到问题，请及时私信上传者）

版权申诉

.net

开发语言

microsoft

0 下载量 196 浏览量 2022-02-18 21:24:59 上传评论 2 收藏 502KB DOC 举报

温馨提示

试读

64页

Excel VBA_控件实例集锦.doc

资源详情

资源评论

1, ComBoBox1 控件的赋值和二级数据有效性

‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=86636&page=1

‘数据有效性.xls

‘运用字典得到不重复值，再用 List 属性赋值

‘运用 Change 事件给下级组合框赋值。

Sub sjyxx()

'ComBoBox1 的数据有效性

Dim Sht1 As Worksheet, i%, x, kb

Dim d, Arrb, Myrb%

Set Sht1 = Sheet1

Myrb = [b65536].End(xlUp).Row

Arrb = Range("b7:b" & Myrb)

Set d = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(Arrb)

x = Arrb(i, 1)

If Not d.exists(x) Then

d.Add x, 1

End If

kb = d.keys

Sheet2.ComboBox1.List = kb ‘一维数组

End Sub

Private Sub ComboBox1_Change()

Dim Arrb, Myrb%, kc, i%, aa

With Sheet1

Myrb = .[b65536].End(xlUp).Row

Arrb = .Range("b7:c" & Myrb)

End With

For i = 1 To UBound(Arrb)

If Arrb(i, 1) = ComboBox1.Text Then

aa = aa & Arrb(i, 2) & ","

End If

Next i

aa = Left(aa, Len(aa) - 1)

kc = Split(aa, ",")

ComboBox3.List = kc

End Sub

2, ListView 控件和 Image 控件

2012.08.15OFFICE2003 安全更新 KB2687324 后 LISTVIEW 无法供应请求类别

http://club.excelhome.net/thread-906629-1-1.html

‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=86636&page=1

‘4 万多人.xls \精品\窗体模糊查询\桌面

‘运用字典得到不重复值，再用 List 属性赋值；调整图片至控件大小

UserForm1 窗体里的代码：

Private Sub CommandButton1_Click()

Dim c, firstAddress$

str1 = TextBox1

str2 = TextBox2

If Len(str1) > 0 Then

With Sht1

Set c = .Range("b:b").Find(str1)

If Not c Is Nothing Then

firstAddress = c.Address

ii = c.Row

Call tb

Set c = .Range("b:b").FindNext(c)

If Not c Is Nothing Then

If firstAddress <> c.Address Then

ii = c.Row

Call tb

End If

Loop While c.Address <> firstAddress

End If

End With

ElseIf Len(str2) > 0 Then

With Sht1

Set c = .Range("a:a").Find(str2)

If Not c Is Nothing Then

firstAddress = c.Address

ii = c.Row

Call tb

Set c = .Range("a:a").FindNext(c)

If Not c Is Nothing Then

If firstAddress <> c.Address Then

ii = c.Row

Call tb

End If

Loop While c.Address <> firstAddress

End If

End With

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Private Sub TextBox1_Change()

If TextBox1.Text = "" Then userform1.ListView1.ListItems.Clear: Image1.Visible = False

End Sub

Private Sub TextBox2_Change()

If TextBox2.Text = "" Then userform1.ListView1.ListItems.Clear: Image1.Visible = False

End Sub

Private Sub UserForm_Initialize()

TextBox1 = ""

TextBox2 = ""

Image1.Visible = False

Set Sht1 = Sheet1

Myr = Sht1.[a65536].End(xlUp).Row

With Me.ListView1

.ColumnHeaders.Clear

.ListItems.Clear

.ColumnHeaders.Add 1, , "身份证号码", ListView1.Width * 0.35

.ColumnHeaders.Add 2, , "姓名", ListView1.Width * 0.15

.ColumnHeaders.Add 3, , "性别", ListView1.Width * 0.1

.ColumnHeaders.Add 4, , "村委", ListView1.Width * 0.3

.ColumnHeaders.Add 5, , "住址详址", ListView1.Width * 0.4

.ColumnHeaders.Add 6, , "电话号码", ListView1.Width * 0.15

.View = lvwReport

End With

End Sub

Private Sub ListView1_Click()

'取回列表值

Dim CurrIndex As Integer

CurrIndex = ListView1.SelectedItem.Index

If CurrIndex < 0 Then Exit Sub

str2 = ListView1.ListItems(CurrIndex).Text

Call plcrtp0119

End Sub

Sub tb()

'填表

Set ITM = ListView1.ListItems.Add()

ITM.Text = Sht1.Cells(ii, 1)

ITM.SubItems(1) = Sht1.Cells(ii, 2)

ITM.SubItems(2) = Sht1.Cells(ii, 3)

ITM.SubItems(3) = Sht1.Cells(ii, 4)

ITM.SubItems(4) = Sht1.Cells(ii, 5)

ITM.SubItems(5) = Sht1.Cells(ii, 6)

End Sub

Sub zb()

'制表

With ListView1

.ColumnHeaders.Clear

.ListItems.Clear

.ColumnHeaders.Add 1, , "身份证号码", ListView1.Width * 0.35

.ColumnHeaders.Add 2, , "姓名", ListView1.Width * 0.15

.ColumnHeaders.Add 3, , "性别", ListView1.Width * 0.1

.ColumnHeaders.Add 4, , "村委", ListView1.Width * 0.3

.ColumnHeaders.Add 5, , "住址详址", ListView1.Width * 0.4

.ColumnHeaders.Add 6, , "电话号码", ListView1.Width * 0.15

.View = lvwReport

End With

End Sub

模块 1 里面的代码：

Public str1$, str2$, i%, ii%, IItext$

Public Sht1 As Worksheet, Myr%, temp

Public ITM As ListItem, m%, nn%, n1%

Sub plcrtp0119()

'从指定图片文件夹（包括子文件夹中）搜索指定的图片，显示在 Image 控件中。

Dim myFs As FileSearch

Dim myPath As String, myFile, temp

Dim i As Long, n As Long, x

Set myFs = Application.FileSearch

myPath = ThisWorkbook.Path '你的图片文件夹

With myFs

.NewSearch

.LookIn = myPath

.FileType = msoFileTypePhotoDrawFiles

.Filename = "*.jpg"

.SearchSubFolders = True ‘包括子目录

If .Execute(SortBy:=msoSortByFileName) > 0 Then

n = .FoundFiles.Count

'MsgBox "该文件夹里有" & n & "个 jpg 文件"

ReDim myFile(1 To n) As String

For i = 1 To n

myFile(i) = .FoundFiles(i)

Else

MsgBox "该文件夹里没有任何文件"

End If

End With

temp = Filter(myFile, str2)

If UBound(temp) <> -1 Then

For x = 0 To UBound(temp)

userform1.Image1.Visible = True

userform1.Image1.Picture = LoadPicture(temp(x))

userform1.Image1.PictureSizeMode = fmPictureSizeModeStretch ‘调整图片至控件大小

Next x

End If

Set myFs = Nothing

End Sub

3, ListView 控件（逐级模糊查询）

‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=49545&page=3

‘资料.xls

Option Explicit

Dim strText$, strLen%, i%, ii%, IItext$

Dim Sht1 As Worksheet, Myr%

Dim ITM As ListItem, n%, m%, nn%, n1%

Private Sub CommandButton1_Click()

Unload Me

剩余63页未读，继续阅读

评论收藏

内容反馈

1.该资源内容由用户上传，如若侵权请联系客服进行举报
2.虚拟产品一经售出概不退款（资源遇到问题，请及时私信上传者）

版权申诉

Excel VBA_控件实例集锦.doc

评论0

最新资源

Excel VBA_控件实例集锦.doc

评论0

最新资源

相关推荐

Excel VBA_编程难点_版主高手实例集锦.doc

Excel VBA_成绩统计分析实例集锦.doc

Excel VBA_插入图片实例集锦.doc

ExcelVBA_类代码实例集锦.doc

Excel VBA_类代码实例集锦.doc

Excel VBA日期控件使用说明

VB_VBA日期选择控件

Excel VBA 实例

Excel_VBA实例

VBA操作Excel的实例

Excel-VBA-类代码实例集锦.doc

ExcelVBA编程150实例大全.doc

Excel VBA_类代码实例集锦.pdf

Excel VBA_VBScript实例集锦.doc

Excel VBA_自定义函数集.doc

Excel VBA_排课表显示实例集锦.doc

Excel VBA 典型实例

Excel+VBA实例

Excel_VBA.doc

Excel VBA实例讲解

Excel VBA 编程实例

Excel VBA_多级动态数据有效性设置实例集锦.doc

Excel VBA实例，很实用的哦

VBA控件技术实例

VBA(Excel)代码.doc

Excel VBA程序设计.doc

Excel_VBA收藏的小实例

Excel+VBA复习资料.doc

Excel_VBA _Api与实例