VBA/Excel/Access/Word/Excel/Worksheets

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

Do... Loop Until Loops with Worksheets

   <source lang="vb">

Sub Create_Worksheets()
    Dim strNewSheet As String
    Do
        strNewSheet = "asdf"
        If strNewSheet <> "" Then
            ActiveWorkbook.Worksheets.Add
            ActiveSheet.Name = strNewSheet
        End If
    Loop Until strNewSheet = ""
End Sub
</source>
   
  


Dynamic Arrays for worksheet name

   <source lang="vb">

Option Base 1 Sub MySheets()

   Dim myArray() As String
   Dim myCount As Integer, NumShts As Integer
   
   NumShts = ActiveWorkbook.Worksheets.count
   ReDim myArray(1 To NumShts)
   
   For myCount = 1 To NumShts
       myArray(myCount) = ActiveWorkbook.Sheets(myCount).name
   Next myCount
   

End Sub

</source>
   
  


For...Next Loop with Worksheet

   <source lang="vb">

    Sub FilePathInFooter()
        Dim i As Integer, sFilePath As String
        sFilePath = ActiveWorkbook.FullName
        For i = 1 To Worksheets.Count Step 1
            Worksheets(i).PageSetup.CenterFooter = sFilePath
        Next i
    End Sub
</source>
   
  


Grouping Worksheets

   <source lang="vb">

    Sub GroupSheets()
        Dim asNames(1 To 3) As String
        Dim i As Integer
        asNames(1) = "Jan 2007"
        asNames(2) = "Mar 2007"
        asNames(3) = "May 2007"
        Worksheets(asNames(1)).Select
        For i = 2 To 3
        Worksheets(asNames(i)).Select Replace:=False
        Next i
    End Sub
</source>
   
  


Looping Through Worksheets in a Workbook

   <source lang="vb">

Sub WorksheetLoop()

   Dim nIndex As Integer 
   For nIndex = 1 To ThisWorkbook.Worksheets.Count 
       Debug.Print ThisWorkbook.Worksheets(nIndex).Name 
   Next 

End Sub

</source>
   
  


move the second worksheet to end of workbook

   <source lang="vb">

Sub SimpleWorksheetMovement()

   ThisWorkbook.Worksheets(2).Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 

End Sub

</source>
   
  


performs a simple bubble sort to sort the worksheets in the workbook

   <source lang="vb">

Sub AlphabetizeWorksheets()

   Dim bSorted As Boolean
   Dim nSheetsSorted As Integer
   Dim nSheets As Integer
   Dim n As Integer
   Dim wb As Workbook
   
   Set wb = ActiveWorkbook
   nSheets = wb.Worksheets.Count
   nSheetsSorted = 0
   Do While (nSheetsSorted < nSheets) And Not bSorted
       bSorted = True
       nSheetsSorted = nSheetsSorted + 1
       For n = 1 To nSheets - nSheetsSorted
           If StrComp(wb.Worksheets(n).name, wb.Worksheets(n + 1).name, vbTextCompare) > 0 Then
               wb.Worksheets(n + 1).Move _
                   before:=wb.Worksheets(n)
               bSorted = False
           End If
       Next
   Loop

End Sub

</source>
   
  


Sort all worksheets

   <source lang="vb">

Sub SortAllSheets()

   Dim wb As Workbook
   Dim ws As Worksheet
   Dim rng As Range
   Dim cSheets As Integer
   Dim sSheets() As String
   Dim i As Integer
   Set wb = ActiveWorkbook
   
   cSheets = wb.Sheets.Count
   ReDim sSheets(1 To cSheets)
   
   For i = 1 To cSheets
     sSheets(i) = wb.Sheets(i).Name
   Next
   
   Set ws = wb.Worksheets.Add
   For i = 1 To cSheets
     ws.Cells(i, 1).Value = sSheets(i)
   Next
   
   ws.Columns(1).Sort Key1:=ws.Columns(1), _
      Order1:=xlAscending
   
   For i = 1 To cSheets
     sSheets(i) = ws.Cells(i, 1).Value
   Next
   
   Application.DisplayAlerts = False
   ws.Delete
   Application.DisplayAlerts = True
   
   For i = 1 To cSheets
     wb.Sheets(sSheets(i)).Move After:=wb.Sheets(cSheets)
   Next
   

End Sub

</source>
   
  


The Sheets Collection

   <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>
   
  


Use for loop to loop through all worksheets

   <source lang="vb">

Sub macro_loop4()

 Dim i
 For i = 1 To ThisWorkbook.Worksheets.Count
   Debug.Print ThisWorkbook.Worksheets(i).Name
 Next i

End Sub

</source>