Help with forcing enable macro and save option.

[Subtemperate]

Hi there,

I'm hoping someone is going able to steer me in the right direction. I am currently using excel 2010 and have created a form that is to be used off a network drive. It has security sensitive information on there, so I have set up a log which will let me know whenever anyone enters the file.

Now the tricky part is that I obviously need Macros to run for this to work, and they can still view the details without enalbing... so I realised I needed to force them to do that first. After searching through google for help I found the following code:

'Force the explicit declaration of variables
Option Explicit


'Assign the name of the warning sheet to a constant
Const Warning As String = "Warning"


Private Sub Workbook_Open()


    'Turn off screen updating
    Application.ScreenUpdating = False
    
    'Call the ShowAllSheets routine
    Call ShowAllSheets
    
    'Set the workbook's Saved property to True
    Me.Saved = True
    
    'Turn on screen updating
    Application.ScreenUpdating = True
    Exit Sub


    
    Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False
    
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)


    'Declare the variable
    Dim Ans As Integer
    
    'If the workbook's Saved property is False, emulate Excel's default save prompt
    If Me.Saved = False Then
        Do
            Ans = MsgBox("Do you want to save the changes you made to '" & _
                Me.Name & "'?", vbQuestion + vbYesNoCancel)
            Select Case Ans
                Case vbYes
                    Call CustomSave
                Case vbNo
                    Me.Saved = True
                Case vbCancel
                    Cancel = True
                    Exit Sub
            End Select
        Loop Until Me.Saved
    End If
    
End Sub


Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


    'Cancel regular saving
    Cancel = True
    
    'Call the CustomSave routine
    Call CustomSave(SaveAsUI)


End Sub




Private Sub CustomSave(Optional SaveAs As Boolean)


    'Declare the variables
    Dim ActiveSht As Object
    Dim FileFormat As Variant
    Dim FileName As String
    Dim FileFilter As String
    Dim FilterIndex As Integer
    Dim Msg As String
    Dim Ans As Integer
    Dim OrigSaved As Boolean
    Dim WorkbookSaved As Boolean
    
    'Turn off screen updating
    Application.ScreenUpdating = False
    
    'Turn off events so that the BeforeSave event doesn't occur
    Application.EnableEvents = False
    
    'Assign the status of the workbook's Saved property to a variable
    OrigSaved = Me.Saved
    
    'Assign the active sheet to an object variable
    Set ActiveSht = ActiveSheet
    
    'Call the HideAllSheets routine
    Call HideAllSheets
    
    'Save workbook or prompt for SaveAs filename
    If SaveAs Or Len(Me.Path) = 0 Then
        If Val(Application.Version) < 12 Then
            FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls"
            FilterIndex = 1
        Else
            FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _
                "Excel 97-2003 Workbook (*.xls), *.xls"
            If Right(Me.Name, 4) = ".xls" Then
                FilterIndex = 2
            Else
                FilterIndex = 1
            End If
        End If
        Do
            FileName = Application.GetSaveAsFilename( _
                InitialFileName:=Me.Name, _
                FileFilter:=FileFilter, _
                FilterIndex:=FilterIndex, _
                Title:="SaveAs")
            If FileName = "False" Then Exit Do
            If IsLegalFilename(FileName) = False Then
                Msg = "The file name is invalid.  Try one of the "
                Msg = Msg & "following:" & vbCrLf & vbCrLf
                Msg = Msg & Chr(149) & " Make sure that the file name "
                Msg = Msg & "does not contain any" & vbCrLf
                Msg = Msg & "   of the following characters:  "
                Msg = Msg & "< > ? [ ] : | or *" & vbCrLf
                Msg = Msg & Chr(149) & " Make sure that the file/path "
                Msg = Msg & "name does not exceed" & vbCrLf
                Msg = Msg & "   more than 218 characters."
                MsgBox Msg, vbExclamation, "Invalid File Name"
            Else
                If Val(Application.Version) < 12 Then
                    FileFormat = -4143
                Else
                    If Right(FileName, 4) = ".xls" Then
                        FileFormat = 56
                    Else
                        FileFormat = 52
                    End If
                End If
                If Len(Dir(FileName)) = 0 Then
                    Application.DisplayAlerts = False
                    Me.SaveAs FileName, FileFormat
                    Application.DisplayAlerts = True
                    WorkbookSaved = True
                Else
                    Ans = MsgBox("'" & FileName & "' already exists.  " & _
                        "Do you want to replace it?", vbQuestion + vbYesNo, _
                        "Confirm Save As")
                    If Ans = vbYes Then
                        Application.DisplayAlerts = False
                        Me.SaveAs FileName, FileFormat
                        Application.DisplayAlerts = True
                        WorkbookSaved = True
                    End If
                End If
            End If
        Loop Until Me.Saved
    Else
        Application.DisplayAlerts = False
        Me.Save
        Application.DisplayAlerts = True
        WorkbookSaved = True
    End If
    
    'Call the ShowAllSheets routine
    Call ShowAllSheets
    
    'Activate the prior active sheet
    ActiveSht.Activate
    
    'Set the workbook's Saved property
    If WorkbookSaved Then
        Me.Saved = True
    Else
        Me.Saved = OrigSaved
    End If
    
    'Turn on screen updating
    Application.ScreenUpdating = True
    
    'Turn on events
    Application.EnableEvents = True
    
End Sub


Private Sub HideAllSheets()


    'Declare the variable
    Dim Sh As Object
    
    'Display the warning sheet
    Sheets(Warning).Visible = xlSheetVisible
    
    'Hide every sheet, except the warning sheet
    For Each Sh In Sheets
        If Sh.Name <> Warning Then
            Sh.Visible = xlSheetVeryHidden
        End If
    Next Sh
    
End Sub


Private Sub ShowAllSheets()


    'Declare the variable
    Dim Sh As Object
    
    'Display every sheet, except the warning sheet
    For Each Sh In Sheets
        If Sh.Name <> Warning Then
            Sh.Visible = xlSheetVisible
        End If
   
         
    Next
    
    'Hide the warning sheet
    Sheets(Warning).Visible = xlSheetVeryHidden
    
    Exit Sub
    Sheets("FSF1").Select
    Range("A1").Select
    Exit Sub
    
    
    
    
End Sub




Private Function IsLegalFilename(ByVal fname As String) As Boolean
    Dim BadChars As Variant
    Dim i As Long
    If Len(fname) > 218 Then
        IsLegalFilename = False
        Exit Function
    Else
        BadChars = Array("\", "/", "<", ">", "?", "[", "]", ":", "|", "*", """")
        fname = GetFileName(fname)
        For i = LBound(BadChars) To UBound(BadChars)
            If InStr(1, fname, BadChars(i)) > 0 Then
                IsLegalFilename = False
                Exit Function
            End If
        Next i
    End If
    IsLegalFilename = True
End Function


Private Function GetFileName(ByVal FullName As String) As String
    Dim i As Long
    For i = Len(FullName) To 1 Step -1
        If Mid(FullName, i, 1) = Application.PathSeparator Then Exit For
    Next i
    GetFileName = Mid(FullName, i + 1)
End Function

Now this has solved my security problem... however I also need the form to remain blank, and when filled in and saved it automatically saves as a name that I require (from 2 cells), and puts it in the directory of my choice. I have a button that enables print and save, but it conflicts with the above code I think, and doesn't seem to save the new file. Here is the code for the button I have:

If MsgBox("File will save with customers name and print one copy.Do you want to proceed? ", vbYesNo, Title:="FSF1") = vbNo Then Exit SubstrSaveAsFile = Application.GetSaveAsFilename("P:\Insertfilename\" & Range("AE16"), "Microsoft Excel Workbook(*.xls), *.xls")
If strSaveAsFile <> "False" Then
ActiveWorkbook.SaveAs strSaveAsFile, xlWorkbookNormal
ActiveSheet.PrintOut Copies:=1

Is there a way to incorporate the two, as any edit I make seems to effect the other. Any help would be greatly appreciated.

 

[JLGWhiz]

For the SaveAs filename variable, I think I would use Range("AE16").Value in the path description, and are you sure you want the file extensions to be .xls? Be sure the variable strSaveAsFile contains whatever file extension you really want to use for the type workbook. And if you are not trying to save to the default directory, you need to include the file path in the SaveAs statement.

 

[mole999]

on you ensure enabled macros i use a simple trick on the workbook on load event, where Sheets("reference lookup").Range("B1") = 0, on close Sheets("reference lookup").Range("B1") = 1 on the worksheet i use CF (=$B$1=1) on the following text .Macros Apparently Disabled

so when the workbook loads and macros are in play, the cell changes to 0 and the CF turns off the highlighting I have,

when the book closes and it become 1 again its ready for the next time

 

[Subtemperate]

For the SaveAs filename variable, I think I would use Range("AE16").Value in the path description, and are you sure you want the file extensions to be .xls? Be sure the variable strSaveAsFile contains whatever file extension you really want to use for the type workbook. And if you are not trying to save to the default directory, you need to include the file path in the SaveAs statement.

Thanks for that getting back to me.... I have removed the file name from the code only for security reasons. I realise now this code is slightly older as I have asked it to save as a macro enabled workbook xlsm. I'm really a beginner and am struggling to understand the variables at present, but that gives me something to work with.

 

[Subtemperate]

on you ensure enabled macros i use a simple trick on the workbook on load event, where [/FONT][/COLOR][B]Sheets("reference lookup").Range("B1") = 0, on close[B]Sheets("reference lookup").Range("B1") = 1 on the worksheet i use CF (=$B$1=1) on the following text .Macros Apparently Disabled

so when the workbook loads and macros are in play, the cell changes to 0 and the CF turns off the highlighting I have,

when the book closes and it become 1 again its ready for the next time

[/B][/B]

Thanks for that, I might try giving that a go at some point.