VBA/Excel/Access/Word/Excel/Worksheet

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

Activate first sheet

 
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



Activate last sheet

 
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



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

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



Determines if a given worksheet name exists in a workbook

 
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



Get Worksheet name

 
Sub getWorkSheetName()
    MsgBox ThisWorkbook.Worksheets(1).Name
End Sub



Get Worksheets count in a Workbook

 
Sub getSheetCount()
    MsgBox ThisWorkbook.Worksheets.Count
End Sub



Gives indexes of sheets

 
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



Group sheets together

 
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



Inserts a new sheet after each sheet

 
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



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

 
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



Reference a worksheet from a workbook

 
Sub referenceWorksheet()
    Workbooks("MyWorkbook").Worksheets("Sheet2").Select
End Sub



Reference worksheet across worksheet

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



Safely Deleting Worksheets Using the DeleteSheet Function

 
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



Select Entire Sheet

 
Sub SelectEntireSheet()
    Cells.Select
End Sub



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

 
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



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

 
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