| 導購 | 订阅 | 在线投稿
分享
 
 
 

各種Excel VBA的命令2

來源:互聯網  2008-09-02 06:53:54  評論

本示例重複最近用戶界面命令。本示例必須放在宏的第一行。

Application.Repeat

下例中,變量 counter 代替了行號。此過程將在單元格區域 C1:C20 中循環,將所

有絕對值小于 0.01 的數字都設置爲 0(零)。

Sub RoundToZero1()

For Counter = 1 To 20

Set curCell = Worksheets("Sheet1").Cells(Counter, 3)

If Abs(curCell.Value) 0 Then

' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL 6

在 Ne00:" '指定打印機

ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,

Collate:=True '設置打印信息,其中Copies:=myPrint爲打印份數

Else

MsgBox "請輸入要打印的份數"

End If

ActiveSheet.ShowAllData '全部顯示

ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼

Sheets("封面").Select

Application.ScreenUpdating = True

End Sub

Sub 打印余額()

Application.ScreenUpdating = False

Sheets("余額表").Select

Call 重算所有表

ActiveSheet.Unprotect Password:=641112 '撤消工作表保護並取消密碼

ActiveWindow.ScrollColumn = 10

Selection.AutoFilter Field:=1, Criteria1:=""

'以下10行彈出窗口輸入打印信息

Dim myPrintNum As Integer

Dim myPrompt, myTitle As String

myPrompt = "請輸入要打印的份數"

myTitle = "打印選取範圍"

myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)

If myPrintNum 0 Then

' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL 6 在

Ne00:" ' '指定打印機

ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,

Collate:=True '設置打印信息,其中Copies:=myPrint爲打印份數

Else

MsgBox "請輸入要打印的份數"

End If

ActiveSheet.ShowAllData '全部顯示

ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼

Sheets("封面").Select

Application.ScreenUpdating = True

End Sub

Sub 備份()

Dim y '變量聲明-需保存工作表的路徑和名稱

[M1] = ActiveWorkbook.FullName '單元格M1=當前工作簿的路徑和名稱

y = cells(1, 14) 'Y=單元格N1的值,即計算後的需保存工作簿的

路徑和名稱

Worksheets("封面").UsedRange.Columns("M:N").Calculate '計算指定

區域

ActiveWorkbook.SaveCopyAs y '備份到指定路麽Y

End Sub

Sub 重算活動表()

With Application

.Calculation = xlManual

.MaxChange = 0.001

End With

ActiveWorkbook.PrecisionAsDisplayed = True

ActiveWindow.DisplayZeros = True

ActiveSheet.Calculate

End Sub

Sub 重算指定表()

Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"

Worksheets("銀行帳").Calculate

Worksheets("日報表").Calculate

End Sub

單元格數據改變引起計算激活過程

Private Sub Worksheet_Change(ByVal Target As Range)

Dim irow, icol As Integer

irow = Target.Row '變量行irow

icol = Target.Column '變量列icol

If irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3)

Then '>大于6行,並且第3列,當本行 3列>2行3列

Application.EnableEvents = False

cells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列

Application.EnableEvents = True

ElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,並且第3列,當本行 3列>2行3列

Application.EnableEvents = False

cells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1

Application.EnableEvents = True

ElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Or

icol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target

""

Application.EnableEvents = False

cells(irow, 5) = "=單位名稱"

cells(irow, 7) = "=摘要"

cells(irow, 11) = "=余額"

Range(cells(irow, 14), cells(irow, 16)) = "=預內外收支NOP"

cells(irow, 17) = "=審核Q"

cells(irow, 18) = "=對帳U"

Range(cells(irow, 19), cells(irow, 20)) = "=內轉收支XY"

cells(irow, 21) = "=政采Z"

Application.EnableEvents = True

End If

End Sub

'計算當前工作表路徑及名稱的函數,可作爲單元格公式,也可寫入宏

=CELL("FILENAME")

'改變Excel界面標題的宏

Private Sub Workbook_Open()

Application.Caption = "吃過了"

End Sub

'自動刷新單元格A1內顯示的日期\時間的宏

Sub mytime()

Range("a1") = Now()

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

End Sub

'用單元格A1的內容作爲文件名保存當前工作簿的宏

Sub b()

ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"

End Sub

'激活窗體的宏,此宏寫入有窗體的工作表內

Private Sub CommandButton1_Click() '點數據錄入按鈕控件激活窗體

Load UserForm3 '激活窗體

UserForm3.StartUpPosition = 3 '激活窗體

UserForm3.Show '激活窗體

End Sub

'以下爲窗體中點擊各按鈕運行的宏,寫入窗體內

Public pos As Integer '聲明變量pos

'戰友確定按鈕語句

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False '此句和最後一句旨在不顯

示宏的執行過程

'On Error GoTo ErrorHandle '可以不要

'ErrorHandle: '可以不要

'If Err.Number = 13 Then '可以不要

'Exit Sub '可以不要

'End If '可以不要

Call writeToWorkSheet '執行宏writetoworksheet

UserForm3.Hide '退出窗體,繼續按鈕少此句,退出按鈕執行此句

Unload UserForm3 '退出窗體,繼續按鈕少此句,退出按鈕執行此句

Call 批量打印 '[此處到接順序2]

[L2] = "" '[到此處結束]

Sheets("打印信息").Select

Application.ScreenUpdating = True

End Sub

'退出按鈕語句

Private Sub CommandButton2_Click()

UserForm3.Hide

Unload UserForm3

End Sub

'將窗體內的文本框中的數據寫進工作表的單元格

Private Sub writeToWorkSheet()

ActiveSheet.Range("k2") = TextBox1.Value '將文字框內容寫進k列

ActiveSheet.Range("l2") = TextBox2.Value '將文字框內容寫進l列

TextBox1.Value = "" '清空文字框內容

TextBox2.Value = "" '清空文字框內容

Worksheets("打印信息").Range("a2").Value = 1 '給指定表的單元格寫入

數據

Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的單元

格數據

End Sub

'以下爲根據條件打印的宏

Sub 打印() '部門明細查詢及批星打印

Application.ScreenUpdating = False '關閉屏幕更新

If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印條件Cells(3,

13) = 1 And

' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL

6 在 Ne00:" ' '指定打印機

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

'設置默認打印機的打印信息,其中Copies:=myPrint爲打印份數

Else

Call 打印信息 '打倒爲假時執行

End If

Application.ScreenUpdating = True '關閉屏幕更新

End Sub

'以下的循環過程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是單元格的內

Sub 批量打印()

For Z = Cells(1, 11) To Cells(1, 12) '變量X的值從打印起始號K1到結束

號L1之間逐漸遞增

Cells(1, 13) = Z 'M1的值等于變量X

Next Z

End Sub

'以下是將打印情況寫入工作表的宏

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. = msoButtonCaption

myButton.Caption = 「退出[&E]」

myButton.OnAction = 「ExitSYS」

Set myButton = myBar.Controls.Add(msoControlButton)

myButton. = 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

本示例重複最近用戶界面命令。本示例必須放在宏的第一行。 Application.Repeat 下例中,變量 counter 代替了行號。此過程將在單元格區域 C1:C20 中循環,將所 有絕對值小于 0.01 的數字都設置爲 0(零)。 Sub RoundToZero1() For Counter = 1 To 20 Set curCell = Worksheets("Sheet1").Cells(Counter, 3) If Abs(curCell.Value) 0 Then ' Application.ActivePrinter = "[url=file://\\zdserver2\HP]\\zdserver2\HP[/url] LaserJet 5000 PCL 6 在 Ne00:" '指定打印機 ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum, Collate:=True '設置打印信息,其中Copies:=myPrint爲打印份數 Else MsgBox "請輸入要打印的份數" End If ActiveSheet.ShowAllData '全部顯示 ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼 Sheets("封面").Select Application.ScreenUpdating = True End Sub Sub 打印余額() Application.ScreenUpdating = False Sheets("余額表").Select Call 重算所有表 ActiveSheet.Unprotect Password:=641112 '撤消工作表保護並取消密碼 ActiveWindow.ScrollColumn = 10 Selection.AutoFilter Field:=1, Criteria1:="" '以下10行彈出窗口輸入打印信息 Dim myPrintNum As Integer Dim myPrompt, myTitle As String myPrompt = "請輸入要打印的份數" myTitle = "打印選取範圍" myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1) If myPrintNum 0 Then ' Application.ActivePrinter = "[url=file://\\zdserver2\HP]\\zdserver2\HP[/url] LaserJet 5000 PCL 6 在 Ne00:" ' '指定打印機 ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum, Collate:=True '設置打印信息,其中Copies:=myPrint爲打印份數 Else MsgBox "請輸入要打印的份數" End If ActiveSheet.ShowAllData '全部顯示 ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼 Sheets("封面").Select Application.ScreenUpdating = True End Sub Sub 備份() Dim y '變量聲明-需保存工作表的路徑和名稱 [M1] = ActiveWorkbook.FullName '單元格M1=當前工作簿的路徑和名稱 y = cells(1, 14) 'Y=單元格N1的值,即計算後的需保存工作簿的 路徑和名稱 Worksheets("封面").UsedRange.Columns("M:N").Calculate '計算指定 區域 ActiveWorkbook.SaveCopyAs y '備份到指定路麽Y End Sub Sub 重算活動表() With Application .Calculation = xlManual .MaxChange = 0.001 End With ActiveWorkbook.PrecisionAsDisplayed = True ActiveWindow.DisplayZeros = True ActiveSheet.Calculate End Sub Sub 重算指定表() Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14" Worksheets("銀行帳").Calculate Worksheets("日報表").Calculate End Sub 單元格數據改變引起計算激活過程 Private Sub Worksheet_Change(ByVal Target As Range) Dim irow, icol As Integer irow = Target.Row '變量行irow icol = Target.Column '變量列icol If irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3) Then '>大于6行,並且第3列,當本行 3列>2行3列 Application.EnableEvents = False cells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列 Application.EnableEvents = True ElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,並且第3列,當本行 3列>2行3列 Application.EnableEvents = False cells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1 Application.EnableEvents = True ElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Or icol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target "" Application.EnableEvents = False cells(irow, 5) = "=單位名稱" cells(irow, 7) = "=摘要" cells(irow, 11) = "=余額" Range(cells(irow, 14), cells(irow, 16)) = "=預內外收支NOP" cells(irow, 17) = "=審核Q" cells(irow, 18) = "=對帳U" Range(cells(irow, 19), cells(irow, 20)) = "=內轉收支XY" cells(irow, 21) = "=政采Z" Application.EnableEvents = True End If End Sub '計算當前工作表路徑及名稱的函數,可作爲單元格公式,也可寫入宏 =CELL("FILENAME") '改變Excel界面標題的宏 Private Sub Workbook_Open() Application.Caption = "吃過了" End Sub '自動刷新單元格A1內顯示的日期\時間的宏 Sub mytime() Range("a1") = Now() Application.OnTime Now + TimeValue("00:00:01"), "mytime" End Sub '用單元格A1的內容作爲文件名保存當前工作簿的宏 Sub b() ActiveWorkbook.SaveCopyAs Range("A1") + ".xls" End Sub '激活窗體的宏,此宏寫入有窗體的工作表內 Private Sub CommandButton1_Click() '點數據錄入按鈕控件激活窗體 Load UserForm3 '激活窗體 UserForm3.StartUpPosition = 3 '激活窗體 UserForm3.Show '激活窗體 End Sub '以下爲窗體中點擊各按鈕運行的宏,寫入窗體內 Public pos As Integer '聲明變量pos '戰友確定按鈕語句 Private Sub CommandButton1_Click() Application.ScreenUpdating = False '此句和最後一句旨在不顯 示宏的執行過程 'On Error GoTo ErrorHandle '可以不要 'ErrorHandle: '可以不要 'If Err.Number = 13 Then '可以不要 'Exit Sub '可以不要 'End If '可以不要 Call writeToWorkSheet '執行宏writetoworksheet UserForm3.Hide '退出窗體,繼續按鈕少此句,退出按鈕執行此句 Unload UserForm3 '退出窗體,繼續按鈕少此句,退出按鈕執行此句 Call 批量打印 '[此處到接順序2] [L2] = "" '[到此處結束] Sheets("打印信息").Select Application.ScreenUpdating = True End Sub '退出按鈕語句 Private Sub CommandButton2_Click() UserForm3.Hide Unload UserForm3 End Sub '將窗體內的文本框中的數據寫進工作表的單元格 Private Sub writeToWorkSheet() ActiveSheet.Range("k2") = TextBox1.Value '將文字框內容寫進k列 ActiveSheet.Range("l2") = TextBox2.Value '將文字框內容寫進l列 TextBox1.Value = "" '清空文字框內容 TextBox2.Value = "" '清空文字框內容 Worksheets("打印信息").Range("a2").Value = 1 '給指定表的單元格寫入 數據 Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的單元 格數據 End Sub '以下爲根據條件打印的宏 Sub 打印() '部門明細查詢及批星打印 Application.ScreenUpdating = False '關閉屏幕更新 If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印條件Cells(3, 13) = 1 And ' Application.ActivePrinter = "[url=file://\\zdserver2\HP]\\zdserver2\HP[/url] LaserJet 5000 PCL 6 在 Ne00:" ' '指定打印機 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '設置默認打印機的打印信息,其中Copies:=myPrint爲打印份數 Else Call 打印信息 '打倒爲假時執行 End If Application.ScreenUpdating = True '關閉屏幕更新 End Sub '以下的循環過程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是單元格的內 容 Sub 批量打印() For Z = Cells(1, 11) To Cells(1, 12) '變量X的值從打印起始號K1到結束 號L1之間逐漸遞增 Cells(1, 13) = Z 'M1的值等于變量X Next Z End Sub '以下是將打印情況寫入工作表的宏 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. = msoButtonCaption myButton.Caption = 「退出[&E]」 myButton.OnAction = 「ExitSYS」 Set myButton = myBar.Controls.Add(msoControlButton) myButton. = 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
󰈣󰈤
王朝萬家燈火計劃
期待原創作者加盟
 
 
 
>>返回首頁<<
 
 
 
 
 熱帖排行
 
 
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有