Create auto open VBA for ALL excel files opened?

[Jarvoisier]

Thanks in advance for any help on this thread. My question is as follows: Is it possible to create a VBA auto-open macro that will run on ALL excel files, not just one specific file? In my line of work it is necessary to format excel spreadsheets in the same manner. With the hope of streamlining the process of processing files, I would like to use the macro code listed below to automatically run every time any excel file is opened rather than having to manually open the file and then push keystrokes to run the macro.

I have researched on this and other forums and have only been able to automatically run a macro when a specific file opens....yet I have not figured out (or learned for that matter) if it is even feasible to create a macro for what I am requesting.

Many thanks in advance and please see the code below for the macro that I'd like to run automatically. Like I mentioned earlier, I can only get this macro to run on the personal.xlsm file itself, and not on successive excel files opened that I would like to have the macro run on automatically.

Private Sub Workbook_Open()
'
' Jarvis_Header_Footer Macro
' Macro recorded 8/23/2011 by Rob Jarvis
'
'
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next

For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
With ws.PageSetup
.LeftHeader = ""
.CenterHeader = "&F"
.RightHeader = ""
.CenterFooter = "&A"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.25)
.FooterMargin = Application.InchesToPoints(0.25)
.PrintHeadings = True
.PrintTitleColumns = ""
End With
Next ws
End Sub

 

[Jarvoisier]

Ahhhh, seeing both of those examples is extremely helpful...I thank you both! When I followed the msg box example yesterday I was confused with the microsoft instructions. Now seeing what should be swaped out really helps. I will try both examples that you guys posted and I will report back.

Thanks again!

 

[Jarvoisier]

I tried shg's example first...and I ran into a snag. I entered all of the code as you posted. When I opened excel I received a Microsoft Visual Basic compile error that says Sub or Function not defined. The part that is highlighted is the "myMacro" line underneath the line Private Sub appXl_WorkbookOpen(ByVal Wb As Workbook)

Any thoughts as to why the error message?

 

[shg]

Did you do this part?

Then put this in a code module of the same add-in:

Private Sub myMacro()
    Dim wks          As Worksheet
     ' ...

It has to go in a standard code module (Insert > Module) in the add-in.

 

[Jarvoisier]

Yes, I did that part as well in the insert>module (however I'm not sure if I put the proper spacing between Dim wks As Worksheet). I double checked everything and I'm still getting same error message.

In your original response you had:

Private Sub appXl_WorkbookOpen(ByVal Wb As Workbook)
my macro

Should I change to:

myMacro

End Sub


I'm typing this from my blackberry on the train. I will copy and paste what I typed in as code when I get home. I may be overlooking something minor.

Thanks again!

 

[shg]

I believe if you copy it from the post, it's fine.

 

[Jarvoisier]

Did you do this part?

It has to go in a standard code module (Insert > Module) in the add-in.

So I copied and pasted everything from the code you wrote...and I'm still getting the following error message:

Compile Error: Sub or Function not defined.

Here are screen shots for the add-in:

ThisWorkbook: http://i76.photobucket.com/albums/j6/JARVOISIER/ThisWorkbook.jpg

Module:
http://i76.photobucket.com/albums/j6/JARVOISIER/Module.jpg

As you can see, in the ThisWorkbook the highlighted code. I don't know if something is incorrect there (forgive my ignorance, my code writing level maxed out at the macro lol).

Thanks in advance!

 

[Jarvoisier]

I made an example using the concept that I linked to earlier.

Insert a class and name it cAOPen.

Option Explicit
 
'http://support.microsoft.com/kb/213566
Public WithEvents aOpen As Application
 
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then MsgBox ActiveWorkbook.Name
End Sub

Replace the MsgBox with the call to your macro.

Insert a Module and add:

Option Explicit
 
Dim autoOpen As New cAOpen
 
Sub SetAutoOpen()
  Set autoOpen.aOpen = Application
End Sub
 
Sub UnSetAutoOpen()
  Set autoOpen.aOpen = Nothing
End Sub

Obviously, you would add your Module level code to this Module or another.

In the ThisWorkbook object:

Private Sub Workbook_Open()
  SetAutoOpen
End Sub

Hi Ken,

Thanks for your example to my query. I was a little bit confused as to what code I was supposed to change in the class module. I have set up links to screen shots of what I wrote from the example you gave me.

Class Module: http://i76.photobucket.com/albums/j6/JARVOISIER/cAOPen.jpg

ThisWorkbook:
http://i76.photobucket.com/albums/j6/JARVOISIER/ThisWorkbook2.jpg

Module 1:
http://i76.photobucket.com/albums/j6/JARVOISIER/Module2.jpg

Thanks in advance!

 

[Kenneth Hobson]

If you are going to use Private for your sub mymacro, then move it into your class. Otherwise, just remove the word Private from Private Sub MyMacro().

The class using MyMacro from a Module is then:

Option Explicit
 
'http://support.microsoft.com/kb/213566
Public WithEvents aOpen As Application
 
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then MyMacro
End Sub

The code works for opening other workbooks, not for adding a new one.

For your MyMacro code in the class method instead of the module:

Public WithEvents aOpen As Application

Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then MyMacro
End Sub

Private Sub MyMacro()
    Dim wks          As Worksheet
 
    For Each wks In ActiveWorkbook.Worksheets
        wks.Visible = xlSheetVisible
        With wks.PageSetup
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .CenterFooter = "&A"
            .RightFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0.25)
            .FooterMargin = Application.InchesToPoints(0.25)
            .PrintHeadings = True
            .PrintTitleColumns = ""
        End With
    Next wks
End Sub

 

[Jarvoisier]

If you are going to use Private for your sub mymacro, then move it into your class. Otherwise, just remove the word Private from Private Sub MyMacro().

The class using MyMacro from a Module is then:

Option Explicit
 
Public WithEvents aOpen As Application
 
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then MyMacro
End Sub

The code works for opening other workbooks, not for adding a new one.

For your MyMacro code in the class method instead of the module:

Public WithEvents aOpen As Application
 
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then MyMacro
End Sub
 
Private Sub MyMacro()
    Dim wks          As Worksheet
 
    For Each wks In ActiveWorkbook.Worksheets
        wks.Visible = xlSheetVisible
        With wks.PageSetup
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .CenterFooter = "&A"
            .RightFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0.25)
            .FooterMargin = Application.InchesToPoints(0.25)
            .PrintHeadings = True
            .PrintTitleColumns = ""
        End With
    Next wks
End Sub

Hi Ken,

I'm starting to get a little embarassed because I have been copying exactly what you have written into the add-in and I still can't get it to work. I think I might be using multiple methods as opposed to the one you had written. I think I have made a hybrid of sorts of what you and mhd wrote.

With the hope of solving the problem, I will paste the code I currently have in each part of the add-in:

ThisWorkbook

Private Sub Workbook_Open()
  SetAutoOpen
End Sub

Module1

Option Explicit
 
Dim autoOpen As New cAOPen
 
Sub SetAutoOpen()
  Set autoOpen.aOpen = Application
End Sub
 
Sub UnSetAutoOpen()
  Set autoOpen.aOpen = Nothing
End Sub

Class Module named cAOPen

Option Explicit
 
'http://support.microsoft.com/kb/213566
Public WithEvents aOpen As Application
 
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then myMacro
End Sub

***Note this is where I receive error message and the line starting "Private Sub aOpen..." is highlighted.

Class Module named myMacro

Public WithEvents aOpen As Application
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then myMacro
End Sub
Private Sub myMacro()
    Dim wks          As Worksheet
 
    For Each wks In ActiveWorkbook.Worksheets
        wks.Visible = xlSheetVisible
        With wks.PageSetup
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .CenterFooter = "&A"
            .RightFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0.25)
            .FooterMargin = Application.InchesToPoints(0.25)
            .PrintHeadings = True
            .PrintTitleColumns = ""
        End With
    Next wks
End Sub

Thanks in advance for your help, much appreciated!!!

 

[Jarvoisier]

Hi All,

I'm still getting an error message for this darn add-in. I will post code as follows to see if you all can find where the screw up is.

Class Module named cAOpen...this is where the highlighted text is. The highlighted part of the line is "If ActiveWorkbook.Name <> ThisWorkbook.Name Then"...

Option Explicit
Public WithEvents aOpen As Application
Private Sub aOpen_WorkbookOpen(ByVal Wb As Workbook)
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then MyMacro
End Sub
Private Sub MyMacro()
    Dim wks          As Worksheet
 
    For Each wks In ActiveWorkbook.Worksheets
        wks.Visible = xlSheetVisible
        With wks.PageSetup
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .CenterFooter = "&A"
            .RightFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0.25)
            .FooterMargin = Application.InchesToPoints(0.25)
            .PrintHeadings = True
            .PrintTitleColumns = ""
        End With
    Next wks
End Sub

Module1:

Option Explicit
 
Dim autoOpen As New cAOpen
 
Sub SetAutoOpen()
  Set autoOpen.aOpen = Application
End Sub
 
Sub UnSetAutoOpen()
  Set autoOpen.aOpen = Nothing
End Sub

ThisWorkbook:

Private Sub Workbook_Open()
  SetAutoOpen
End Sub

If preferred I can take screen shots and post those as well. Many thanks in advance for any help and attention!

RJ