久久国产成人av_抖音国产毛片_a片网站免费观看_A片无码播放手机在线观看,色五月在线观看,亚洲精品m在线观看,女人自慰的免费网址,悠悠在线观看精品视频,一级日本片免费的,亚洲精品久,国产精品成人久久久久久久

分享

VBA|使用工作表對象Worksheet操作和管理工作表

 止觀觀止 2017-11-09

Worksheet對象表示Excel工作表,,可通過Workbooks集合對象和Worksheet對象的屬性、方法和事件對工作表進行操作和管理,。

VBA|使用工作表對象Worksheet操作和管理工作表

1 使用工作表集合對象Worksheets管理工作表

1.1 用Add方法新增工作表

Sub 新增工作表()

Dim str1 As String

On Error Resume Next

str1 = Application.InputBox(prompt:='請輸入已有工作表名稱,,' & vbNewLine & _

'新增的工作表將位于該工作表前面。', _

Title:='輸入原工作表名稱', Type:=2)

Worksheets.Add Before:=Worksheets(str1)

End Sub

1.2 用Delete方法刪除工作表

Sub 刪除工作表()

Dim str1 As String

On Error GoTo err1

str1 = Application.InputBox(prompt:='請輸入要刪除的工作表名稱:', _

Title:='輸入工作表名稱', Type:=2)

If str1 = 'False' Then Exit Sub

Application.DisplayAlerts = False '不顯示警告信息

Worksheets(str1).Delete

Application.DisplayAlerts = True

Exit Sub

err1: '錯誤處理

MsgBox '不能刪除工作表“' & str1 & '”,!'

Application.DisplayAlerts = True

End Sub

1.3 用Count屬性得到工作表數(shù)量

Sub 工作表數(shù)量()

Dim i As Long

i = Worksheets.Count

MsgBox '當前工作簿的工作表數(shù)為:' & i

End Sub

1.4 用Select方法選擇工作表

Worksheets(1).Select

2 使用工作表對象Worksheet管理工作表

2.1 用copy方法復制工作表

Sub 復制工作表()

Dim ws1 As Worksheet

Set ws1 = ActiveSheet

MsgBox '復制當前工作到前面,。'

ws1.Copy Before:=ws1

MsgBox '得制當前工作表到后面。'

ws1.Copy After:=ws1

End Sub

2.2 用Visible屬性隱藏工作表

Sub 隱藏工作表()

Dim str1 As String, ws1 As Worksheet

str1 = Application.InputBox(prompt:='請輸入需要隱藏的工作表:', _

Title:='隱藏工作表', Default:='Sheet1', Type:=2)

On Error GoTo err1

Set ws1 = Worksheets(str1)

ws1.Visible = xlSheetHidden

Exit Sub

err1:

MsgBox '輸入的工作表不存在,!'

End Sub

2.3 用Move方法移動工作表

ActiveSheet.Move Before:=Sheets(1)

2.4 用Activate方法激活工作表

Sub 逐個激活工作表()

Dim sh As Worksheet

For Each sh In Worksheets

sh.Activate

MsgBox '激活工作表名稱為:' & sh.Name & vbNewLine & _

'單擊【確定】按鈕將激活下一工作表,!'

Next

End Sub

2.5 用Previous、Next屬性選取前后工作表

Sub 選擇前工作表()

If ActiveSheet.Index <> 1 Then

ActiveSheet.Previous.Activate

Else

MsgBox '已到第一個工作表'

End If

End Sub

Sub 選擇后工作表()

If ActiveSheet.Index <> Worksheets.Count Then

ActiveSheet.Next.Activate

Else

MsgBox '已到最后一個工作表'

End If

End Sub

2.6 用ProtectContents屬性獲取工作表保護狀態(tài)

Sub 工作表保護狀態(tài)()

If ActiveSheet.ProtectContents Then

MsgBox '當前工作表已保護,!'

Else

MsgBox '當前工作表未保護,!'

End If

End Sub

2.7 用Protect方法保護工作表

Sub 保護工作表()

On Error Resume Next

Dim ws1 As Worksheet

Dim str1 As String

str1 = Application.InputBox(prompt:='請輸入保護工作表的密碼:', _

Title:='輸入密碼', Type:=2)

For Each ws1 In Worksheets

ws1.Protect Password:=str1

Next

MsgBox '所有工作表保護完成!'

End Sub

2.8 用Unprotected方法撤銷工作表的保護

Sub 撤消工作表保護()

On Error GoTo err1

Dim ws1 As Worksheet

Dim str1 As String

str1 = Application.InputBox(prompt:='請輸入撤消保護工作表的密碼:', _

Title:='輸入密碼', Type:=2)

For Each ws1 In Worksheets

ws1.Unprotect Password:=str1

Next

MsgBox '所有工作表的保護已被撤消,!'

Exit Sub

err1:

MsgBox '輸入的密碼錯誤,,不能取撤消對工作表的保護!'

End Sub

2.9 用HpageBreaks,、VPageBreaks屬性計算打印頁數(shù)

Sub 計算頁數(shù)()

Dim r As Long, c As Long, p As Long

Dim ws1 As Worksheet

Set ws1 = ActiveSheet

c = ws1.HPageBreaks.Count + 1

r = ws1.VPageBreaks.Count + 1

p = r * c

MsgBox '當前工作表共有' & p & '頁,。'

End Sub

2.10 用Shapes屬性控制工作表中的圖片

Sub 刪除圖片()

Dim p As Shape

For Each p In ActiveSheet.Shapes

If p.Type = msoPicture Then p.Delete

Next

End Sub

2.11 用Hyperlinks集合處理超鏈接

Sub 添加超鏈接()

Dim i As Integer

With ActiveSheet

For i = 1 To Worksheets.Count - 1

.Cells(i + 2, 2).Value = Worksheets(i + 1).Name

.Hyperlinks.Add anchor:=Cells(i + 2, 2), _

Address:='', SubAddress:=Cells(i + 2, 2).Value & '!a1', _

TextToDisplay:=Cells(i + 2, 2).Value

Next

End With

End Sub

Sub 刪除超鏈接()

Dim h As Hyperlink, hs As Hyperlinks

Set hs = ActiveSheet.Hyperlinks

For Each h In hs

h.Delete

Next

End Sub

2.12 自定義函數(shù)判斷工作表是否存在

Function WorksheetExists(ByVal SheetName As String) As Boolean

Dim sName As String

On Error GoTo err1

sName = Worksheets(SheetName).Name

WorksheetExists = True

Exit Function

err1:

WorksheetExists = False

End Function

3 響應用戶操作

3.1 用SelectionChange事件禁止選中某個區(qū)域

例如,以下代碼將禁止用戶選擇B1:F3單元格區(qū)域:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim r As Long, c As Long

r = Target.Row

c = Target.Column

If r <= 3="" and="" c="">= 2 And c <= 6="" then="">

End Sub

3.2 用ScrollArea屬性設置滾動區(qū)域

例如,,如下代碼限制用戶只能選擇A-E列中的單元格

Private Sub Worksheet_Activate()

ActiveSheet.ScrollArea = 'A1:E1048576'

End Sub

3.3 用countif函數(shù)禁止輸入相同數(shù)據(jù)

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Target.Column = 2 Then

If Target.Value <> '' And WorksheetFunction.CountIf(Columns(2), Target.Value) > 1 Then

MsgBox '請不要輸入相同的數(shù)據(jù),!'

Application.Undo

End If

End If

Application.EnableEvents = True

End Sub

3.4 用SelectionChange事件輸入連續(xù)的數(shù)據(jù)

例如,以下代碼就可以限制用戶的選擇只能是A列中有內(nèi)容的單元格或其后一個單元格

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

i = ActiveSheet.Range('A65536').End(xlUp).Row

j = Target.Column

If Target.Row > i Then

Cells(i + 1, j).Select

End If

End Sub

3.5 用BeforeRightClick事件增加快捷菜單

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

For Each mnu1 In Application.CommandBars('cell').Controls

If mnu1.Tag = 'MyMenu' Then mnu1.Delete

Next

If Not Application.Intersect(Target, Range('A1:C10')) Is Nothing Then

With Application.CommandBars('cell').Controls.Add _

(Type:=msoControlButton, before:=6, temporary:=True)

.Caption = '測試命令'

.OnAction = '顯示測試信息'

.Tag = 'MyMenu'

End With

End If

End Sub

在模塊中保存以下過程

Sub 顯示測試信息()

MsgBox '你選擇了用戶添加的快捷菜單,!' & _

vbCrLf & '本例為測試代碼,,未編寫具體的功能。'

End Sub

3.6 用Deactivate事件限制選擇其他工作表

Private Sub Worksheet_Deactivate()

ActiveSheet.Activate

MsgBox '您無權(quán)操作其他工作表,,只能在“Sheet1”工作表中進行操作,!', _

vbCritical + vbOKOnly, '警告'

End Sub

3.7 用Activate事件隱藏工作表

Private Sub Worksheet_Activate()

Dim ws As Worksheet

For Each ws In Worksheets '循環(huán)隱藏每個工作表

If ws.Name <> '主界面' Then ws.Visible = False

Next

End Sub

Sub 顯示工作表()

Dim ws As Worksheet

For Each ws In Worksheets

ws.Visible = xlSheetVisible

Next

End Sub

3.8 用Interior屬性突出顯示當前位置

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Integer

On Error Resume Next

i = Target.Interior.ColorIndex

If i < 0="">

i = 36

Else

i = i + 1

End If

If iColor = Target.Font.ColorIndex Then '避免字體顏色與突出色相同

i = i + 1

End If

Cells.Interior.ColorIndex = xlColorIndexNone

Rows(Target.Row).Interior.ColorIndex = i

Columns(Target.Column).Interior.ColorIndex = i

End Sub

    本站是提供個人知識管理的網(wǎng)絡存儲空間,所有內(nèi)容均由用戶發(fā)布,,不代表本站觀點,。請注意甄別內(nèi)容中的聯(lián)系方式、誘導購買等信息,,謹防詐騙,。如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容,請點擊一鍵舉報,。
    轉(zhuǎn)藏 分享 獻花(0

    0條評論

    發(fā)表

    請遵守用戶 評論公約

    類似文章 更多