Thread: Build an Array of visible worksheets

may be so

Sub PrintMe()
Dim myarray$(), i&, wks As Worksheet
For Each wks In Worksheets
    If wks.Name = "Summary" Or wks.Name = "Raw" Or wks.Visible = xlSheetVeryHidden Then
    Else
        ReDim Preserve myarray(i)
        myarray(i) = wks.Name
        i = i + 1
    End If
Next wks
Sheets(myarray).Select
...

@ nilem ... Thanks, The Array part works just fine , but the script only sets up the pagebreaks on the first sheet. I'm guessing this is a send key issue?

@ OnErrorGoto0 The reason I dont want to loop through every worksheet and setup the page info is it takes a lot of time compared to just selecting all the worksheets at once. The script is suppose to be able to select the one worksheet and it copies all the page setup info to all the other worksheets.

I'll keep messing with it for the time being, not sure what is wrong at this time.
Thank You,
Mike

The array part works fine, however nothing but problems with the page setup. I have re-thought my script and removed that portion of the script to update page setup. I now have created a script that will insert a worksheet activate script from a text file. Which goes something like this:

Credit goes to Leith Ross and Shg who helped me out a long time ago with this type of method.

LoadTextFile "C:\Documents and Settings\ME\Desktop\AddText.txt"

Sub LoadTextFile(ByVal TextFile As String, Optional OverWrite As Boolean)
  
  Dim Cnt As Long
  Dim CodeTxt As String
  Dim FSO As Object
  Dim vbProj As Object
  Dim VBComp As Object

    If Dir(TextFile) = "" Then
       MsgBox "File Not Found." & vbCrLf & TextFile, vbCritical
       Exit Sub
    End If

    Set vbProj = ActiveWorkbook.VBProject 'Application.VBE.ActiveVBProject
    Set VBComp = vbProj.VBComponents(wk.CodeName)
    
      Cnt = VBComp.CodeModule.CountOfLines
      
     'Clear the Code Module
      If OverWrite = True Then
         VBComp.CodeModule.DeleteLines 1, Cnt
      End If
      
     'Read in the Text file
      Set FSO = CreateObject("Scripting.FileSystemObject")
        CodeTxt = FSO.OpenTextFile(TextFile).ReadAll
        
       'Load the Code Module with the file text
        VBComp.CodeModule.InsertLines Cnt + 1, CodeTxt
      
   'Free objects
    Set FSO = Nothing
    Set vbProj = Nothing
    Set VBComp = Nothing
    
End Sub

And the text file is located on my desktop which is named (AddText.txt)

Here is whats in the text file: This method seems much faster and works so far with my tests.

PHP Code: 


Private Sub Worksheet_Activate()

Application.ScreenUpdating = False
On Error GoTo exits:

        
        ActiveWindow.View = xlPageBreakPreview
        VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
        ActiveWindow.View = xlNormalView
        PageSetup.PrintArea = RealUsedRange.Address
 
 
       
        With ActiveSheet.PageSetup
        .PrintTitleRows = "$21:$21"
        
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .BlackAndWhite = True
        .Zoom = 95
        
        End With
        Range("A22").Select:   ActiveWindow.FreezePanes = True
        Range("A1").Select:   ActiveWindow.Zoom = True
     
exits:
 
Application.ScreenUpdating = True

End Sub
Public Function RealUsedRange() As Range
     
    Dim FirstRow        As Long
    Dim LastRow         As Long
    Dim FirstColumn     As Integer
    Dim LastColumn      As Integer
     
    On Error Resume Next
     
    FirstRow = Cells.Find(What:="*", after:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
     
    FirstColumn = Cells.Find(What:="*", after:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
     
    LastRow = Cells.Find(What:="*", after:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    LastColumn = Cells.Find(What:="*", after:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
     
    Set RealUsedRange = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn))
     
    On Error GoTo 0
     
End Function 


Hope this may help someone else someday.

Thank You, Mike