Excel-常用宏技巧（5）

以下是将打印情况写入工作表的宏

Sub 打印信息()

Application.ScreenUpdating = False '关闭屏幕更新

Dim Y '声明变量

Y = ActiveSheet.Name '判定活动工作表名称

Sheets("打印信息").Select

X = 3 '从第3行开始

Do While Not (IsEmpty(Cells(X, 2).Value)) '判断第1列的最后一行(即空行的上一行)

X = X + 1 '在最后一行加一行即为空行

Loop

Cells(X, 2) = Cells(2, 1)

Cells(X, 3) = Sheets(Y).Cells(4, 3)

Cells(2, 1) = Cells(2, 1) + 1

Cells(X, 4) = Sheets(Y).Cells(1, 4)

Cells(X, 5) = Sheets(Y).Cells(1, 5)

[c1] = Y

Sheets(Y).Select '返回上一次打开的工作表

Application.ScreenUpdating = True '打开屏幕更新

End Sub

将文件保存为以某一单元格中的值为文件名的宏怎么写

假设你要以Sheet1的A1单元格中的值为文件名保存，则应用命令：

ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"

在Excel中,如何用程式控制某一单元格不可编辑修改?thanks!!!

Private Sub Workbook_Open()

ProtectSpecialRange ("A1")

End Sub

Sub ProtectSpecialRange(RangeAddress As String)

On Error Resume Next

With Sheet1

.Cells.Locked = False

.Range(RangeAddress).Locked = True

.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range(RangeAddress) _

, Password:="pass"

.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End With

End Sub

对工作表编程，有时要判断工作表的记录总数，VBA里如何实现？

x=1

do while not (isempty(sheets("").cells(x,1).value)

x=x+1

loop

在VBA中等同于EXCELE中的求和函数-sum()-的函数是什么?

Application.WorksheetFunction.Sum()

自定义菜单有三个菜单项，要求手工顺序执行。为防止误操作，执行完第一个菜单项后使其变灰（禁用），如何写？

Rowen

令其 Enable　属性同步与某个工具按钮是较为方便的。

如何进行表格更新？

是这样的，比如我已经有了一个原始表格A，这时有人通知我A表有错误，须加以修改，并给我一个表B，表B列出了须修改的参数（注意B的列数少于A的列数，因A的其他列无需修改）。现在问题是如何根据表B中的新值，在表A中找到相应位置，并加以修改。比如表B中列出了10002的JOHN的身高和体重等值需要修改，如何在A中找到10002的相应位置（身高体重），并加以修改。

建議將表b複製至表a的sheet2，然後執行下列的宏即可

sub change()

dim dd as range

sheets(2).select

lastcell = range("a65536").end(xlup).row

for each dd in range(cells(2, 1), cells(lastcell, 1))

if dd = "" then exit sub

ff = dd.value

set c = sheets(1).columns(1).find(ff, lookat:=xlwhole)

if not c is nothing then

c.offset(0, 2) = dd.offset(0, 2)

c.offset(0, 3) = dd.offset(0, 3)

c.offset(0, 5) = dd.offset(0, 4)

end if

next

end sub

自定义菜单

把建立和删除自定义菜单的代码分别写在Workbook_open和Workbook_beforeclosed的事件中。

应该用VBA，工作薄代码中有workbook-open()过程，在该过程中写入

with activeworkbook

.sheets("表2").active

end with

VBA实现向锁定工作表中插入行,并自动复制上面行中指定列的函数

Option Explicit

Public Const strPass = "123" 123是口令

Sub 行上再插入一行()

ActiveSheet.Unprotect password:=strPass

Selection.Copy

Selection.Insert Shift:=xlDown

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

ActiveSheet.Protect password:=strPass

End Sub

如何使不出现每次关闭XLS文件时出现的：

“XXX.xls文件已被修改，是否可在其修改后的内容？”字样？？

可以在工作表关闭之前进行手工保存工作

　　ThisWorkbook.save

如何实现动态时间显示?

sub mytime

range("a1")=now()

Application.OnTime Now + Timevalue("00:00:01"), "mytime"

end sub

用 vba 判断指定 excel 文件是否打开？

For Each w In Workbooks

If w.Name <> XXX Then

…………

End If

Next w

vba怎么调用excel自带的函数?比如vlookup?

Application.WorksheetFunction.f(x)

f(x)是你想使用的工作表函数

但是用内部函数时引用单元格会出错，怎么办？

把你要引用的单元格改成VBA认可格式（类型）。如在Excel中的“F7:F12”应改为“Range("F7:F12")”等。

VBA中如何关闭,保存和退出Excel?

Workbooks("你的工作簿").Save。

下表举例说明了使用 Rows 和 Columns 属性的一些行和列的引用。

引用 含义

Rows(1) 第一行

Rows 工作表上所有的行

Columns(1) 第一列

Columns("A") 第一列

Columns 工作表上所有的列

若要同时处理若干行或列，请创建一个对象变量并使用 Union 方法，将对 Rows 属性或 Columns 属性的多个调用组合起来。下例将活动工作簿中第一张工作表上的第一行、第三行和第五行的字体设置为加粗。

Sub SeveralRows()

Worksheets("Sheet1").Activate

Dim myUnion As Range

Set myUnion = Union(Rows(1), Rows(3), Rows(5))

myUnion.Font.Bold = True

End Sub

如果只是你说的只连接几个储存格那用简单的方法

Range("A1").Formula = Application.Evaluate("=[Book2.xls]Sheet1!A1")

或

Range("A1").Formula = "=[Book2.xls]Sheet1!A1"

请问在vba如何呼叫已定义的名称范围

我在a1:b100插入名称∶myrange

请问我如何用vba选取此范围

Range("myrange").Select

如何访问没有打开的EXCEL文件？

Sub AlternativeImport()

Dim xlapp As Excel.Application

Dim wbSource As Excel.Workbook

Set xlapp = New Excel.Application

xlapp.EnableEvents = False

Set wbSource = xlapp.Workbooks.Open("C:/test/Book2.xls")

Range("A1:A10").Value = wbSource.Sheets("Sheet1").Range("A1:A10").Value

wbSource.Close False

xlapp.Quit

End Sub

怎样使VBAprject工程不可查看？（不用密码）

用可编辑十六进制文件的软件工具（如WinHex等）打开Excel.xls,在文件的尾部,查找ID="{00000000-0000-0000-0000-000000000000}"(有工程锁定密码时),或ID="{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}"(没有工程锁定密码时),修改其中的任意1位后,保存,即可达到目的.当查看工程是会出现“工程不可查看”的提示.

注意:修改前,一定要备份原文件,以防不测

如何用VBA控制报表的格式（左边距，纸张大小，打印第几页等）

打印第几页控制:ActiveWindow.SelectedSheets.PrintOut From:=x, To:=y

ActiveSheet.PageSetup.LeftMargin= 左边距

ActiveSheet.PageSetup..PaperSize = 纸张大小

如何使VBA自动消除使用COPY复制后产生的虚线框？

Application.CutCopyMode = False

 

替换Excel 97的菜单栏是很容易的，只需创建一个新的菜单栏就会删除Excel 97的菜单栏。当需要恢复Excel 97的菜单栏时，只要删除新创建的菜单栏就可以了。该系统的自定义菜单中只需两个命令按钮，一个用来返回到系统的主画面（ReturnMAIN），另一个用来退出系统（ExitSYS）。下面是模块（Module）中有关的宏或是事件控制程序。

Sub ZapMenu( )

On Error Resume Next

CommandBars(“保险查询系统”).Delete

End Sub

这是一个用来删除自定义菜单栏的宏。语句On Error Resume Next保证无论自定义菜单栏是否存在都能正确删除它。

Sub ExitSYS( )

ZapMenu

ActiveWorkbook.Close SaveChanges := False

End Sub

这是用来退出系统的宏。它删除自定义菜单，并关闭活动的工作簿（不提示保存修改）。

Sub ReturnMAIN( )

Worksheets(“保险查询系统”).Select

End Sub

该宏用来返回主画面。它激活“保险查询系统”工作表。

Sub SetMenu( )

Dim myBar As CommandBar

Dim myButton As CommandBarButton

ZapMenu

Set myBar = CommandBars.Add(Name:=“保险查询系统”, _

Position :=msoBarTop, _

MenuBar :=True)

Set myButton = myBar.Controls.Add(msoControlButton)

myButton.Style = msoButtonCaption

myButton.Caption = “退出[&E]”

myButton.OnAction = “ExitSYS”

Set myButton = myBar.Controls.Add(msoControlButton)

myButton.Style = msoButtonCaption

myButton.Caption = “返回[&R]”

myButton.OnAction = “ReturnMAIN”

myButton.Visible = False

myBar.Protection = msoBarNoMove + msoBarNoCustomize

myBar.Visible = True

End Sub

这个宏包含五部分。第一部分定义了一对变量。第二部分首先运行ZapMenu宏，保证保险查询系统菜单栏是不存在的，然后创建它。参数MenuBar的值设为True，确保这个新创建的命令栏为一菜单栏。第三部分和第四部分将两个命令按钮加入到菜单栏中。并设置ReturnMAIN命令按钮的初始状态为不可见状态。最后一部分保护这个新创建的菜单栏，使用户不能移动也不能自定义新菜单栏。

 

工作表汇总

Sub sum() '表汇总,第1张的a1:e20等于所有表的相同单元格的和

Attribute sum.VB_ProcData.VB_Invoke_Func = "z/n14"

Dim X As Worksheet

For y = 1 To 20

For z = 1 To 5

For Each X In Worksheets

shname = X.Name

ActiveSheet.Cells(y, z).Value = ActiveSheet.Cells(y, z).Value + Worksheets(shname).Cells(y, z)

Next

Next z

Next y

End Sub