| 導購 | 订阅 | 在线投稿
分享
 
 
當前位置: 王朝網路 >> vb >> 各種Excel VBA的命令2
 

各種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
 
 
 
上一篇《KMPLAYER無法播放rmvb格式的解決辦法》
下一篇《各種Excel VBA的命令1》
 
 
 
日版寵物情人插曲《Winding Road》歌詞

日版寵物情人2017的插曲,很帶節奏感,日語的,女生唱的。 最後聽見是在第8集的時候女主手割傷了,然後男主用嘴幫她吸了一下,插曲就出來了。 歌手:Def...

兄弟共妻,我成了他們夜裏的美食

老鍾家的兩個兒子很特別,就是跟其他的人不太一樣,魔一般的執著。兄弟倆都到了要結婚的年齡了,不管自家老爹怎麽磨破嘴皮子,兄弟倆說不娶就不娶,老父母爲兄弟兩操碎了心...

如何磨出破洞牛仔褲?牛仔褲怎麽剪破洞?

把牛仔褲磨出有線的破洞 1、具體工具就是磨腳石,下面墊一個硬物,然後用磨腳石一直磨一直磨,到把那塊磨薄了,用手撕開就好了。出來的洞啊很自然的。需要貓須的話調幾...

我就是掃描下圖得到了敬業福和愛國福

先來看下敬業福和愛國福 今年春節,支付寶再次推出了“五福紅包”活動,表示要“把欠大家的敬業福都還給大家”。 今天該活動正式啓動,和去年一樣,需要收集“五福”...

冰箱異味産生的原因和臭味去除的方法

有時候我們打開冰箱就會聞到一股異味,冰箱裏的這種異味是因爲一些物質發出的氣味的混合體,聞起來讓人惡心。 産生這些異味的主要原因有以下幾點。 1、很多人有這種習...

《極品家丁》1-31集大結局分集劇情介紹

簡介 《極品家丁》講述了現代白領林晚榮無意回到古代金陵,並追隨蕭二小姐化名“林三”進入蕭府,不料卻陰差陽錯上演了一出低級家丁拼搏上位的“林三升職記”。...

李溪芮《極品家丁》片尾曲《你就是我最愛的寶寶》歌詞

你就是我最愛的寶寶 - 李溪芮 (電視劇《極品家丁》片尾曲) 作詞:常馨內 作曲:常馨內 你的眉 又鬼馬的挑 你的嘴 又壞壞的笑 上一秒吵鬧 下...

烏梅的功效與作用以及烏梅的食用禁忌有哪些?

烏梅,又稱春梅,中醫認爲,烏梅味酸,性溫,無毒,具有安心、除熱、下氣、祛痰、止渴調中、殺蟲的功效,治肢體痛、肺痨病。烏梅泡水喝能治傷寒煩熱、止吐瀉,與幹姜一起制...

什麽是脂肪粒?如何消除臉部脂肪粒?

什麽是脂肪粒 在我們的臉上總會長一個個像脂肪的小顆粒,弄也弄不掉,而且顔色還是白白的。它既不是粉刺也不是其他的任何痘痘,它就是脂肪粒。 脂肪粒雖然也是由油脂...

網絡安全治理:國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰受害者

來源:中國青年報 新的攻擊方法不斷湧現,黑客幾乎永遠占據網絡攻擊的上風,我們不可能通過技術手段杜絕網絡攻擊。國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰...

 
 
 
本示例重複最近用戶界面命令。本示例必須放在宏的第一行。 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- 王朝網路 版權所有