VBA/Excel/Access/Word/Excel/Worksheet

Материал из VB Эксперт
Перейти к: навигация, поиск

Activate first sheet

   <source lang="vb">

Sub GotoFirstSheet()

 Dim i&
 For i = 1 To Sheets.Count
   If Sheets(i).Visible And TypeName(Sheets(i)) <> "Module" Then
     Sheets(i).Select
     Exit Sub
   End If
 Next i

End Sub

</source>
   
  


Activate last sheet

   <source lang="vb">

Sub GotoLastSheet()

 Dim i&
 For i = Sheets.Count To 1 Step -1
   If Sheets(i).Visible And TypeName(Sheets(i)) <> "Module" Then
     Sheets(i).Select
     Exit Sub
   End If
 Next i

End Sub

</source>
   
  


changes the value of the Name property of the first worksheet in the first workbook of the Excel application:

   <source lang="vb">

Sub changeValue()

   Application.Workbooks(1).Worksheets(1).name = "My Sheet"

End Sub

</source>
   
  


Determines if a given worksheet name exists in a workbook

   <source lang="vb">

Private Function WorksheetExists(wb As Workbook, sName As String) _

   As Boolean 
   Dim s As String 
   On Error GoTo WorksheetExistsErr 
   s = wb.Worksheets(sName).Name 
   WorksheetExists = True 
   Exit Function 

WorksheetExistsErr:

   WorksheetExists = False 

End Function

</source>
   
  


Get Worksheet name

   <source lang="vb">

Sub getWorkSheetName()

   MsgBox ThisWorkbook.Worksheets(1).Name

End Sub

</source>
   
  


Get Worksheets count in a Workbook

   <source lang="vb">

Sub getSheetCount()

   MsgBox ThisWorkbook.Worksheets.Count

End Sub

</source>
   
  


Gives indexes of sheets

   <source lang="vb">

Sub WorksheetIndex()

 Dim i As Integer
 For i = 1 To ThisWorkbook.Worksheets.Count
   MsgBox ThisWorkbook.Worksheets(i).Name & " has Index = " _
     & ThisWorkbook.Worksheets(i).Index
 Next i

End Sub

</source>
   
  


Group sheets together

   <source lang="vb">

Sub Groupsheets()

  Dim stNames(1 To 2) As String
  Dim i As Integer
  stNames(1) = "Sheet2"
  stNames(2) = "Sheet3"
  Worksheets(stNames(1)).Select
  For i = 1 To 2
     Worksheets(stNames(i)).Select Replace:=False
  Next i

End Sub

</source>
   
  


Inserts a new sheet after each sheet

   <source lang="vb">

Sub InsertChartsAfterWorksheets()

  Dim myWorksheet As Worksheet
  Dim myChart As Chart

  For Each myWorksheet In Worksheets
     Set myChart = Charts.Add
     myChart.Move After:=myWorksheet
  Next myWorksheet

End Sub

</source>
   
  


Loop through all worksheets in workbook and reset values in a specific range on each sheet.

   <source lang="vb">

Sub Reset_Values_All_WSheets()

   Dim myWorksheet As Worksheet
   Dim myRng As Range
   Dim cel As Range
   
   For Each myWorksheet In Worksheets
   Set myRng = myWorksheet.Range("A1:A5, B6:B10, C1:C5, D4:D10")
       For Each cel In myRng
           If Not cel.HasFormula And cel.Value <> 0 Then
               cel.Value = 0
           End If
       Next cel
   Next myWorksheet

End Sub

</source>
   
  


Reference a worksheet from a workbook

   <source lang="vb">

Sub referenceWorksheet()

   Workbooks("MyWorkbook").Worksheets("Sheet2").Select

End Sub

</source>
   
  


Reference worksheet across worksheet

   <source lang="vb">

Sub ReferAcrossWorksheets4()

 With Sheets("Sheet1")
   .Range(.Cells(1, 1), .Cells(10, 5)).Font.Bold = True
 End With

End Sub

</source>
   
  


Safely Deleting Worksheets Using the DeleteSheet Function

   <source lang="vb">

Function DeleteSheet(ws As Worksheet, bQuiet As Boolean) As Boolean

   Dim bDeleted As Boolean 
   On Error GoTo ErrHandler 
   bDeleted = False  
   If CountVisibleSheets(ws.Parent) > 1 Then 
       If bQuiet Then Application.DisplayAlerts = False 
       bDeleted = ws.Parent.Worksheets(ws.Name).Delete 
   End If 

ExitPoint:

   Application.DisplayAlerts = True 
   DeleteSheet = bDeleted 
   Exit Function 

ErrHandler:

   bDeleted = False 
   Resume ExitPoint 

End Function Function CountVisibleSheets(wb As Workbook) As Integer

   Dim nSheetIndex As Integer 
   Dim nCount As Integer 
   nCount = 0 
   For nSheetIndex = 1 To wb.Sheets.Count 
       If wb.Sheets(nSheetIndex).Visible = xlSheetVisible Then 
           nCount = nCount + 1 
       End If 
   Next 
   CountVisibleSheets = nCount 

End Function

</source>
   
  


Select Entire Sheet

   <source lang="vb">

Sub SelectEntireSheet()

   Cells.Select

End Sub

</source>
   
  


Using a Function to Check for the Existence of a Code Name

   <source lang="vb">

Function WorksheetCodeNameExists(wb As Workbook, sCodeName As String) As Boolean

   Dim s As String 
   Dim ws As Worksheet 
   WorksheetCodeNameExists = False 
   For Each ws In wb.Worksheets 
       If StrComp(ws.CodeName, sCodeName, vbTextCompare) = 0 Then 
           WorksheetCodeNameExists = True 
           Exit For 
       End If 
   Next 
   Set ws = Nothing 

End Function

</source>
   
  


Using the Parent Property to Obtain a Reference to an Object"s Parent Object

   <source lang="vb">

Sub MeetMySingleParent()

   Dim ws As Worksheet 
   Set ws = ThisWorkbook.Worksheets("Sheet1") 
   " Please meet my parent - Mrs. Workbook 
   Debug.Print ws.Parent.Name 
   Set ws = Nothing 

End Sub

</source>