VBA常用注释代码Word格式文档下载.docx

VBA常用注释代码Word格式文档下载.docx

《VBA常用注释代码Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《VBA常用注释代码Word格式文档下载.docx（11页珍藏版）》请在冰豆网上搜索。

DimResultStrAsString

DimFileNameAsString

DimFileNumAsInteger

DimCounterAsDouble

FileName=Application.GetOpenFilename

IfFileName="

ThenEnd

FileNum=FreeFile（）

OpenFileNameForInputAs#FileNum

Application.ScreenUpdating=False

Workbooks.AddTemplate:

=xlWorksheet

Counter=1

DoWhileSeek（FileNum）<

=LOF（FileNum）

Application.StatusBar="

ImportingRow"

_

Counter&

"

oftextfile"

FileName

LineInput#FileNum,ResultStr

IfLeft（ResultStr,1）="

="

Then

ActiveCell.Value="

'

ResultStr

Else

ActiveCell.Value=ResultStr

EndIf

IfActiveCell.Row=65536Then

ActiveWorkbook.Sheets.Add

ActiveCell.Offset（1,0）.Select

Counter=Counter+1

Loop

Close

Application.StatusBar=False

如何用vba代码显示当前工作簿是只读状态还是可修改状态：

MsgBoxThisWorkbook.ReadOnly

欲判断单元格中是否是#N/A如何处理.如:

IfRange（"

F"

bl&

）.Value="

#N/A"

Then

这样该单元格内容类型是否为字符串.不加引号报错.:

Subbb（）

Settestrng=[b1]

IfIsError（testrng）Then

Iftestrng=CVErr（xlErrNA）Then

MsgBox"

就是#N/A"

Else

其他错误"

EndIf

没有错误"

SubUseFileDialogOpen（）

DimlngCountAsLong

'

Openthefiledialog

WithApplication.FileDialog（msoFileDialogOpen）

.AllowMultiSelect=True

.Show

Displaypathsofeachfileselected

ForlngCount=1To.SelectedItems.Count

MsgBox.SelectedItems（lngCount）

NextlngCount

EndWith

从另外一个未打开的Excel文件中读取数据的函数

下面这个函数调用XLM宏从未打开的工作簿中读取数据.

注意:

该函数不能用于公式.

GetValue函数,需要以下四个变量

path:

未打开的Excel文件的路径（e.g.,"

d:

\test"

）

file:

文件名（e.g.,"

test.xls"

sheet:

工作表的名称（e.g.,"

Sheet1"

ref:

引用的单元格（e.g.,"

C4"

PrivateFunctionGetValue（path,file,sheet,ref）

从未打开的Excel文件中检索数据

DimargAsString

确保该文件存在

IfRight（path,1）<

>

\"

Thenpath=path&

IfDir（path&

file）="

GetValue="

FileNotFound"

ExitFunction

创建变量

arg="

path&

["

file&

]"

sheet&

!

Range（ref）.Range（"

A1"

）.Address（,,xlR1C1）

执行XLM宏

GetValue=ExecuteExcel4Macro（arg）

EndFunction

使用该函数:

将该语句复制到VBA的模块中,然后,在适当的语句中调用该函数.下面的例子显示D:

\test下的文件test.xls的Sheet1中的单元格”A1”的内容.

SubTestGetValue（）

p="

f="

s="

a="

MsgBoxGetValue（p,f,s,a）

下面还有一个例子.这个语句从一个未打开的文件中读取1200个数值（100行12列）,并将结果填到当前工作表中.

SubTestGetValue2（）

\test"

Application.ScreenUpdating=False

Forr=1To100

Forc=1To12

a=Cells（r,c）.Address

Cells（r,c）=GetValue（p,f,s,a）

Nextc

Nextr

Application.ScreenUpdating=True

说明:

如果工作簿处于隐藏状态,或者工作表是图表工作表,将会报错.

在VBA中怎么象"

我的电脑中的文件夹档"

一样让用户自已选择路径和文件.

选择文件：

Application.GetopenFilename

选择文件夹：

1、Application.FileDialog（msoFileDialogFolderPicker）

在H列，从H3开始，每隔3行分别输入A到H！

Dimarr（1To65536,1To1）,iAsLong

Fori=3To65536Step4

arr（i,1）=Chr（（（i-3）\4）Mod8+65）

Next

Range（"

h1:

h65536"

）=arr

Application.ScreenUpdating=True

有一單元格，我設置了格式為自動換行。

現在想通過程式取得這個單元格自動換行產生的行數

DimaAsInteger,iAsInteger,jAsInteger,kAsInteger,wAsSingle,tAsString,ttAsString

t=CStr（ActiveCell）

tt=t

w=ActiveCell.ColumnWidth

ActiveCell.WrapText=False

ActiveCell.ClearContents

a=Len（tt）

i=1

j=0

k=0

Do

ActiveCell=Left（tt,i）

ActiveCell.Columns.AutoFit

IfActiveCell.ColumnWidth>

wThen

ActiveCell.ColumnWidth=w

k=k+1

tt=Right（tt,Len（tt）-i+1）

i=1

i=i+1

j=j+1

Ifj>

aThen

k=k+1

ExitDo

Loop

ActiveCell=t

ActiveCell.WrapText=True

自动换行行数为"

k

PrivateSubWorksheet_SelectionChange（ByValTargetAsExcel.Range）

IfTarget.Row>

=2Then

OnErrorResumeNext

[ChangColor_With].FormatConditions.Delete

Target.Name="

ChangColor_With"

With[ChangColor_With].FormatConditions

.Delete

.AddxlExpression,,"

TRUE"

.Item

（1）.Interior.ColorIndex=35

.Item

（1）.Font.Bold=True

.Item

（1）.Font.ColorIndex=3

.Item

（1）.Font.Size=20

.Item

（1）.Font.Name="

ｷsｲﾓｩ愰・

.Item

（1）.Font.Italic=True

.Item

（1）.Font.Underline=xlUnderlineStyleSingle

[ChangColor_With1].FormatConditions.Delete

Target.EntireRow.Name="

ChangColor_With1"

With[ChangColor_With1].FormatConditions

.Item

（1）.Interior.ColorIndex=24

[ChangColor_With2].FormatConditions.Delete

[ChangColor_With3].FormatConditions.Delete

ChangColor_With2"

Target.EntireColumn.Name="

ChangColor_With3"

With[ChangColor_With2].FormatConditions

With[ChangColor_With3].FormatConditions

工作表有加载宏，打开时自动加载菜单，是一个3级的，当加载另外的一个宏时，建立新菜单，接在前一个菜单下

ForEachMenuItem1JInCommandBars

（1）.Controls

IfMenuItem1J.Caption=A"

ThenGoTo1

Next

SetMenuItem1J=CommandBars

（1）.Controls.Add（Type:

=msoControlPopup）

MenuItem1J.Caption=A"

1:

ForEachMenuItem2JInMenuItem1J.Controls

IfMenuItem2J.Caption="

B"

ThenGoTo2

SetMenuItem2J=MenuItem1J.Controls.Add（Type:

MenuItem2J.Caption="

SetMenuItem3J=MenuItem2J.Controls.Add（Type:

=msoControlButton）

MenuItem3J.Caption="

B-1"

MenuItem3J.OnAction="

Macro1"

B-2"

进度条：

PrivateSubCommandButton1_Click（）

Dimi,maxn,dd,ffAsInteger

maxn=100

UserForm1.Show

dd=5

ff=101

Fori=1Tomaxn

Cells（i,1）=maxn-Cells（i,1）.Value+1

UserForm1.Label1.Width=Int（i/maxn*218）

IfUserForm1.Label1.Width>

=101Then

IfUserForm1.Label1.Width-1=ffThen

ff=UserForm1.Label1.Width

UserForm1.TextBox3.Text=CStr（Int（i/maxn*100））+"

%"

IfUserForm1.Label1.Width<

=124Then

dd=dd+1

UserForm1.TextBox3.Width=dd

Application.Wait（Now+TimeValue（"

0:

00:

01"

））

UserForm1.TextBox2.Text=IIf（Int（i/maxn*100）<

10,"

CStr（Int（i/maxn*100））+"

CStr（Int（i/maxn*100））+"

DoEvents

Nexti

done"

UnloadUserForm1