help with add in

Thanks Andy,

I dowloaded an example that worked but not for the function I want it to. I would like to activate the macro with the Beforesave event but for some how it doesn't work with this. I have tried to activate the macro with sheetactivate and sheetchange event and then it works perfect.

Any ideas why it won't work with Beforesave?

In ThisWorkbook:

Option Explicit

Dim AppClass As New EventClass

Private Sub Workbook_Open()

Set AppClass.App = Application

End Sub

In a class module:

Public WithEvents App As Application

Private Sub App_SheetActivate(ByVal Sh As Object) '''WORKS

'Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) '''FALES

Dim SecurityLevel()
Dim CurFoot
Dim Level As Integer

Level = 0

SecurityLevel = Array("Secret", "Confidential", "Proprietary", "Public")

CurFoot = Worksheets("Sheet1").PageSetup.LeftFooter

'If CurFoot = Application.UserName & ", " & "&D" & Chr(10) & "Security Class <" & SecurityLevel(1) & ">" Then Exit Sub
'If CurFoot = Application.UserName & ", " & "&D" & Chr(10) & "Security Class <" & SecurityLevel(2) & ">" Then Exit Sub
'If CurFoot = Application.UserName & ", " & "&D" & Chr(10) & "Security Class <" & SecurityLevel(3) & ">" Then Exit Sub
'If CurFoot = Application.UserName & ", " & "&D" & Chr(10) & "Security Class <" & SecurityLevel(4) & ">" Then Exit Sub

On Error Resume Next
Do Until Level = 1 Or Level = 2 Or Level = 3 Or Level = 4
Level = InputBox("To AFR secure this document type in security level, otherwise cancel.1 = Secret, 2 = Confidential, 3 = Proprietary and 4 = Public.", "Update the date")
If Level = 0 Then
Exit Sub ''' Cancel pressed
End If
Loop

Worksheets("Sheet1").PageSetup.LeftFooter = Application.UserName & ", " & "&D" & Chr(10) & "Security Class <" & SecurityLevel(Level) & ">"

End Sub

Cheers

Jonas

JS at 2007-10-2 >

Thanks Andy for taking your time with this.

The code however still won't work. But the problem seems to be in the last line,

Wb.Worksheets("Sheet1").PageSetup.LeftFooter = "test"

The code below works for the green marked alternative at the end but not for the red marked. It is kind of strange since it sometimes works with the PageSetup.leftfooter choice but not always. I have tried to run the code in a regular macro that is trigged by the play macro command and then it works! Do you know why PageSetup.leftfoot won't work when trigged by the BeforeSave event?

Public WithEvents App As Application
Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim SecurityLevel()
Dim CurFoot
Dim Level

Level = 0

SecurityLevel = Array("Secret", "Confidential", "Proprietary", "Public")

CurFoot = Worksheets("Sheet1").PageSetup.LeftFooter

On Error Resume Next
Do Until Level = 1 Or Level = 2 Or Level = 3 Or Level = 4
Level = InputBox("To AFR secure this document type in security level, otherwise cancel.1 = Secret, 2 = Confidential, 3 = Proprietary and 4 = Public.")
If Level = 0 Then
Exit Sub ''' Cancel pressed
End If
Loop

Wb.Worksheets("Sheet1").Range("A3") = "test"
Wb.Worksheets("Sheet1").PageSetup.LeftFooter = "test"

End Sub

Cheers

Jonas

JS at 2007-10-2 >

Yes that is correct the input request works. It is just the PageSetup function that seems to fail. No error mesages.

JS at 2007-10-2 >

Strange for me never. I tried with workbookbeforeclose and that worked!? But not workbookbeforesave. I will try to solve it in an other way. Thanks for your support.

Cheers

Jonas

JS at 2007-10-2 >

I'm using the same as you 2003 sp2.

I have sent my file to your box.

Cheers

JS at 2007-10-2 >