[分享]ExcelVBA程序集汇总(连续更新中......)

fanjy · 发表于 2006-8-24 14:21

程序46：工作表列A的值改变时,重新排序

在本示例中，如果您对工作表Sheet1中A列的值改变或在A列中添加值，工作表会对A列到D列中的数据进行重新排序(数据是动态的)，并相应的行进行调整，同时工作表Sheet2中的数据进行同步更新。

将下面的程序代码输入到工作表Sheet1模块中：

‘*****************************************************

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub

Worksheets("Sheet2").Range(Target.Address).Value = Target.Value

Range(("A1"), Cells(Rows.Count, 1).End(xlUp).Offset(0, 3)).Sort _

key1:=Range("A2"), order1:=xlAscending, header:=xlYes

Range("A:D").Copy Worksheets("Sheet2").Range("A:D")

End Sub

‘*****************************************************

示例文档见 (程序46)对A列排序并调整相应的行.xls。

TFMyfac1.rar (6.48 KB, 下载次数: 266)

fanjy · 发表于 2006-8-24 17:21

程序47：UCase函数的使用

当您在工作表的A列中输入小写字母时，自动转换成大写字母。

将下面的程序代码输入到工作表Sheet1模块中：

‘*****************************************************

Private Sub Worksheet_Change(ByVal Target As Range)

If IsEmpty(Target) Then Exit Sub

If Target.Cells.Count > 1 Then Exit Sub

If Target.Column > 1 Then Exit Sub

Application.EnableEvents = False

Target.Value = UCase(Target.Value)

Application.EnableEvents = True

End Sub

‘*****************************************************

示例文档见程序(47)自动转换成大写.xls。

LJjpicFQ.rar (6.47 KB, 下载次数: 214)

fanjy · 发表于 2006-8-30 13:24

下面几个程序是关于工作簿事件的示例.

程序48：阻止另存为命令的使用
本示例将阻止在工作簿中选择菜单“文件——另存为”命令的使用。当您选择“另存为”命令后，将会弹出一个消息框，告诉您不能使用另存为命令更改工作簿的名称。但您可以对该工作簿进行重命名。
下面的代码放置在ThisWorkbook代码模块中：
‘*****************************************************
Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As Long
If SaveAsUI = True Then
     lReply = MsgBox("对不起,您不能用其它名称保存本工作簿. ", vbQuestion + vbOKCancel)
     Cancel = (lReply = vbCancel)
     If Cancel = False Then Me.Save
     Cancel = True
End If
End Sub
‘*****************************************************
示例文档见 (程序48)在工作簿中阻止另存为命令的使用.xls。 SglvS0Vi.rar (5.67 KB, 下载次数: 198)

szljq · 发表于 2006-8-30 15:35

fanjy，你的精神让我敬佩，我要向你多多学习。对你的贡献，表示感谢。

fanjy · 发表于 2006-8-31 13:24

程序52：一个进度条示例
在本示例中，当打开工作簿时会弹出一个窗口并显示进度条和信息。
在VBE编辑器中，插入一个用户窗体并布局，在窗体中有一个图片控件、一个进度条和三个标签。然后写代码如下。
以下为用户窗体中相关控件的代码：
‘*****************************************************
Private Sub UserForm_Initialize()
Label3.Caption = Format(Now, "dddd d mmmm yyyy hh:mm:ss")
End Sub
‘*****************************************************
Private Sub UserForm_Activate()
Dim dTime As Date
Dim i As Integer
For i = 1 To 100 Step 100 / 8
    dTime = Now + TimeValue("0:00:01")
    Application.Wait TimeValue(dTime)
    ProgressBar1.Value = i
Next i
End Sub
‘*****************************************************
Private Sub Label2_Click()
ThisWorkbook.FollowHyperlink "http://fanjy.blog.excelhome.net"
End Sub
‘*****************************************************
以下为工作簿中的代码，实现当工作簿打开时显示用户窗体。
‘*****************************************************
Private Sub Workbook_Open()
Application.OnTime EarliestTime:= _
Now + TimeValue("00:00:08"), Procedure:="EndSplash"
UserForm1.Show
End Sub
‘*****************************************************
卸载用户窗体的代码：
‘*****************************************************
Sub EndSplash()
Unload UserForm1
End Sub
‘*****************************************************
注意，用户窗体等待时间与进度条控制时间应一致。
示例文档见 (程序52)一个进度条示例.xls。

ivsn7s0P.rar (27.51 KB, 下载次数: 302)

fanjy · 发表于 2006-9-5 13:20

程序53：将公式结果转换为值
本示例将由公式所产生的结果转换为数值，即按要求运行程序后，公式单元格区域将转换成数值。当您再编辑这些区域时，不会显示公式，而是数值。
‘*****************************************************
Sub ValuesOnly()
Dim rRange As Range
On Error Resume Next
Set rRange = Application.InputBox(Prompt:="请选取公式单元格区域", _
Title:="转换为数值", Type:=8)
If rRange Is Nothing Then Exit Sub
rRange = rRange.Value
End Sub
‘*****************************************************
示例文档见 (程序53)将公式产生的结果转换成数值.xls。

iR4RqED0.rar (6.11 KB, 下载次数: 267)

sniper777 · 发表于 2006-9-5 20:25

[em17][em17][em17]

yxfeXCEL · 发表于 2006-9-6 14:00

不是一般的敬佩，那是相当的敬佩！这里再有五位楼主这样的老师，全国的水平能再上一尺啊！

十分感谢fanjy老师！

图片点击可在新窗口打开查看

gljzyp · 发表于 2006-9-7 09:39

这么好的东西要是能够打包就更好了！！

不过还是感谢楼主！！

冰比冰水冰 · 发表于 2006-9-15 11:54

楼主，你弄个厉害哈

		自动登录	找回密码
密码			免费注册