Collections

Workbook/Worksheet collection

dim wkBook as Workbook
dim wkSheet as Worksheet
for each wkBook in Workbooks
   for each wkSheet in Application.Worksheets
      msgbox wkBook.Name & " -- " & wkSheet.Name
   next wkSheet
next wkBook

Repeat top 3 lines on all sheets in workbook for each worksheet item in the collection

You cannot select all sheets and use File, Page Setup, Sheets, Rows to Repeat at top: $1:$3
so you would need a macro.

Option Explicit
Sub Top3LinesAllSheets()
   Dim wkSheet As Worksheet
   For Each wkSheet In Application.Worksheets
        With wkSheet.PageSetup
          .PrintTitleRows = "$1:$3"
       End With
       Sheets(wkSheet.Name).Rows("1:3").Font.Bold = True
   Next wkSheet
End Sub

Using the Worksheets.count

Dim wc As Integer
For wc = 1 To ThisWorkbook.Worksheets.Count
  ThisWorkbook.Worksheets(wc).PrintOut
next wc

Obtaining Cell Counts for all Sheets in All Open Workbooks

Sub AllsheetsInOpenBooks()   
'Example in http://www.mvps.org/dmcritchie/excel/collections.htm  
Dim wkBook As Workbook, wkSheet As Worksheet   ' 2001-11-24
Dim iRow As Long, iSheet As Long:   iRow = 1
'Create a new sheet in the current workbook
'  added sheet automatically becomes the active sheet.
   Worksheets.Add After:=Sheets(Sheets.Count)
   Set wkSheet = ActiveSheet
   Columns("A:B").NumberFormat = "@"
   Columns("C").NumberFormat = "#,###""S"""
   Range("a1:g1") = Array("workbook", "Sheet", _
      "pos", "rows", "cols", "Cells", "Value in A1")
   Rows("1:1").Font.Bold = True
For Each wkBook In Workbooks
   iSheet = 0
   For Each wkSheet In wkBook.Worksheets
      iRow = iRow + 1: iSheet = iSheet + 1
      Cells(iRow, 1) = wkBook.Name
      Cells(iRow, 2) = wkSheet.Name
      Cells(iRow, 3) = iSheet 'placement
      'can't use SpecialCells(xlLastCell) if protected
      Cells(iRow, 4).Value = wkSheet.UsedRange.Rows.Count
      Cells(iRow, 5).Value = wkSheet.UsedRange.Columns.Count
      Cells(iRow, 6) = Cells(iRow, 4) * Cells(iRow, 5)
      Cells(iRow, 7) = wkSheet.Cells(1, 1).Text
      On Error GoTo 0
   Next wkSheet
Next wkBook
    Cells.EntireColumn.AutoFit
    If Columns("G").ColumnWidth > 45 Then _
       Columns("G").ColumnWidth = 43
    '-- Sort results
    Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, _
        Key2:=Range("B2"), Order2:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
    Range("A1").Select
End Sub

Open the Workbooks seen in column A

sPath = "C:\My Documents\"
On Error Resume Next
For each cell in Range("A1",Range("a1").End(xlDown))
    workbooks.open Filename:=sPath & cell.Value & ".xls"
Next
On Error goto 0
For Each cell In Range("A1", Range("a1").End(xlDown))
    Workbooks.Open (cell & ".xls")
                If Err.Number = 1004 Then
       MsgBox "Does not exist"
    End If
Next

Run a macro against all Workbooks in a directory

A solution provided by Tom Ogilvy, 2001-08-05, in programming. which he indicates is an adaptation of code from help on FileSearch object

Sub ProcessBooks()
Dim wkbk As Workbook
Dim i As Long
With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = False
    .FileName = "*.xls"
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
            Set wkbk = _
              Workbooks.Open(FileName:=.FoundFiles(i))
            ' run macro to process file
            wkbk.Close SaveChanges:=True
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub

Close all Workbooks except active

Sub CloseAllButActive()
  'based on Tom Ogilvy's postings
  Dim wkbk As Workbook
  For Each wkbk In Application.Workbooks
    If wkbk.Name <> ActiveWorkbook.Name Then
      If Windows(wkbk.Name).Visible = True Then
        'MsgBox wkbk.Name & " " & Windows(wkbk.Name).Visible
        wkbk.Close SaveChanges:=False  'or make it true
      End If
    End If
  Next
End Sub

Menu & Submenus Collections

Names Collection

Sub a()
    Dim Nm As Name
    For Each Nm In Names
        Nm.Visible = True
    Next
End Sub

Sub ShowNames()
   Dim N As Integer
   For N = 1 To ActiveWorkbook.Names.Count
      On Error Resume Next
      Cells(N, 1) = "'" & ActiveWorkbook.Names(N).Name
      Cells(N, 2) = "'" & ActiveWorkbook.Names(N).RefersToRange.Address
      Cells(N, 3) = "'" & ActiveWorkbook.Names(N).ShortcutKey
      Cells(N, 4) = "'" & ActiveWorkbook.Names(N).Visible
   Next
End Sub

List all names in workbook

Sub List_Named_Ranges()
Dim nms As Names
Dim n As Long 'count of range names
On Error Resume Next
Set nms = ActiveWorkbook.Names
      For n = 1 To nms.Count
        Cells(n, 2).Value = nms(n).Name
        Cells(n, 3).Value = nms(n).RefersToRange.Address
        Cells(n, 4) = nms(n).Visible
      Next
End Sub

additional Name objects
Application, Category, CategoryLocal, Creator, Delete, Index, MacroType, Name, NameLocal, Parent, RefersTo, RefersToLocal, RefersToR1C1, ReferstoR1C1Local, RefersToRange, ShortcutKey, Value, Visible

Hyperlinks collection

The following contains example code for going through the worksheets in the workbook and/or coloring each object type hyperlink.  Just an example.  Note we have to use parent.address because .address would the link.  The buildtoc.htm page contains most of material on hyperlinks.  Example by Dave Peterson (2001-12-13)

Sub ColorLinks()
    Dim myLnk As Hyperlink
   'Dim wks As Worksheet
   ' For Each wks In ActiveWorkbook.Worksheets
       'For Each myLnk In wks.Hyperlinks
        For Each myLnk In ActiveSheet.Hyperlinks
           'MsgBox myLnk.Parent.Address & vbLf & _
                   myLnk.Parent.Parent.Name
            Range(myLnk.Parent.Address).Interior.ColorIndex = 34
        Next myLnk
   ' Next wks
End Sub

Right Click Menus

The following is from Jim Rech, 2001-06-14, misc, to list right-click menus.

"Jim Rech" <jarech@kpmg.com> wrote in message news:#FbWaQP9AHA.408@tkmsftngp05
> Given that most popup commandbars appear via a mouse right click you could
> list all of them (popups) with this macro:
>
Sub ListPopups()
Dim CB As CommandBar
Dim Counter As Integer
For Each CB In CommandBars
    If CB.Type = msoBarTypePopup Then
        Counter = Counter + 1
        Cells(Counter, 1).Value = CB.Name
    End If
Next
End Sub

> And then select any one that looked interesting and run this
> macro to see what it looks like: (slight modifications)
>
Sub RunPopup()
    If  IsEmpty(ActiveCell) then exit sub
    On Error Resume Next
    Err.Number = 0
    CommandBars(ActiveCell.Value).ShowPopup
    If Err.Number <> 0 Then
      MsgBox Err.Number & " " & Err.Description _
       & Chr(10) & "Helpcontext: " & Err.HelpContext _
       & Chr(10) & "Helpfile: " & Err.HelpFile _
       & Chr(10) & "Source: " & Err.Source
    End If
End Sub
>
> Of course you'd have to figure out in what context a given
> commandbar pplies to see it in normal use.
>
'
'The following Event macro simplifies usage of the above.  David
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Use  Alt  or  Esc  to clear popup
  RunPopup
End Sub

There is No Collection name for...

ComboBox, see Chip Pearson's code and explanation in Google of OLEObject container

what icon button is this?

Related

Please send your comments concerning this web page to: David McRitchie mailto:DMcRitchie@msn.com