Excel Macro

[scohan]

I've copied an auto_open and auto_close macro into an excel file. When I open the file, a pop-up window asks if I want to enable macros. Can I do something so this doesn't pop-up and the macros are automatically enabled?

Also, more importantly, when I close the file (even without makeing any changes) I'm prompted whether I want to save then changes to the file. How can I prevent this from popping up if no changes were made? I suspect it has to do with the macros being enabled when the file was opened. Thanks.

 

[Dreamboat]

Hello!

1. On YOUR PC, you can go to Tools-Options-General and remove macro virus protection OR (if Office 2000) go to Tools-Macros-Macro Security and set it to low. There is code, I believe that can bypass someone's macro security setting, but I don't know it.

2. Of course the file is changed. You're running a macro that's doing something--it must be making changes to the file--but now you don't want to save it? Do an on-close macro that says something like Save=No.

Go down to Maureen's real recent post and copy the url's I gave her. Lots of little code tidbits at those sites for download or copy.
techsupportgirl@home.com

http://www.WeDoManuals.com

Brainbench MVP for Microsoft Word at

http://www.brainbench.com

 

[scohan]

I noticed after my first post that in the file that I copied that macros from I'm prompted whether I want to enable macros upon startup, but I'm not prompted whether I want to save my changes upon exit. Does it make any sense that I'm not prompted for saving in the source file, but I am in the second file? Thanks.

 

[Dreamboat]

This is entirely dependent on what your macro does. If you want to paste the code...

I don't know the difference between your source file and "2nd" file. Be happy to take a look at the file(s).
techsupportgirl@home.com

http://www.WeDoManuals.com

Brainbench MVP for Microsoft Word at

http://www.brainbench.com

 

[scohan]

The macro code is the same in both the source file and the 2nd file. Here it is. The Autpen and Auto_Close are at the bottom. Thanks fo taking a looksee.

Option Explicit

Global MyMenuItem1 As Object 'Export Menu
Public MySubMenuItem1 As Object 'Invoke Export Script
Public MySubMenuItem2 As Object 'Insert Template Tables
Dim MyOutput As String
Dim MyPath As String
Dim MyRow As Integer
Dim MsgText As String
Dim MsgTitle As String
Dim LenderID As Double

Public Sub StartExport()

Dim ExportSheetFound As Boolean
Dim LenderIDFound As Boolean
Dim CreationDate As String
Dim i As Integer
Dim x As Integer
Dim MBRP As Integer

MyRow = 2
ExportSheetFound = False
LenderIDFound = False
CreationDate = Year(Now) & "/" & Month(Now) & "/" & Day(Now)
CreationDate = CreationDate & " " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)

'CHECK FOR EXPORT SHEET AND SELECT IF FOUND
'IF NOT FOUND, SEND MSG TO USER AND END
For i = 1 To Sheets.Count
If Sheets(i).Name = "Export" Then
Sheets(i).Select
ExportSheetFound = True
End If
Next i

'CHECK FOR LENDER ID SHEET AND GET LENDER ID
For i = 1 To Sheets.Count
If Sheets(i).Name = "Lender ID" Then
LenderIDFound = True
LenderID = Range("'Lender ID'!B3&quot
End If
Next i

If ExportSheetFound = True And LenderIDFound = True Then
'SELECT OUTPUT PATH
MsgText = "Export to Floppy?" & Chr(13)
MsgText = MsgText & "Selecting NO will output the Export.txt file to C:\Program Files\LoanRates Lenders\"
MsgTitle = "Select Output Path"
MBRP = MsgBox(MsgText, vbYesNo, MsgTitle)
If MBRP = vbYes Then
MyPath = "a:\Export.txt"
Else
MyPath = "c:\Program Files\LoanRates Lenders\Export.txt"
End If

Application.ScreenUpdating = False

On Error Resume Next
Open MyPath For Output As #1
If Err.Number = 76 Then
MsgText = "The specified path does not exist. Do you want to create it now?"
MsgTitle = "Path Not Found"
MBRP = MsgBox(MsgText, vbQuestion + vbYesNo, MsgTitle)
If MBRP = vbYes Then
MkDir "c:\Program Files\LoanRates Lenders\"
Else
MsgText = "Export Aborted"
MsgTitle = "Export Aborted"
MsgBox MsgText, vbInformation + vbOKOnly, MsgTitle
End
End If
Else
If Err.Number = 71 Then
MsgText = "Please insert floppy disk into drive A and try again"
MsgTitle = "Error = Disk not ready"
MsgBox MsgText, vbCritical + vbOKOnly, MsgTitle
End
End If

Close #1
End If

Open MyPath For Output As #1
Range("B2&quot.Select

Do Until ActiveCell.Value = "END" Or MyRow > 10000
If ActiveCell.Offset(0, 1) <> &quot;&quot; Then
MyOutput = CreationDate & &quot;,&quot;
MyOutput = MyOutput & LenderID & &quot;,&quot; & ActiveCell.Value & &quot;,&quot;
MyOutput = MyOutput & Chr(34) & ActiveCell.Offset(0, 1) & Chr(34)
For x = 2 To 57
MyOutput = MyOutput & &quot;,&quot; & ActiveCell.Offset(0, x)
Next x
Print #1, MyOutput
End If
MyRow = MyRow + 1
MyOutput = &quot;&quot;
Range(&quot;B&quot; & MyRow).Select
Loop

Close #1

Application.ScreenUpdating = True
Range(&quot;A1&quot.Select
Range(&quot;A2&quot.Select

MsgText = &quot;Export Complete&quot;
MsgTitle = &quot;Export Complete&quot;
MsgBox MsgText, vbInformation + vbOKOnly, MsgTitle
Else
If ExportSheetFound = False Then
MsgText = &quot;Export worksheet not found.&quot;
MsgTitle = &quot;Error - Data not found&quot;
MsgBox MsgText, vbCritical + vbOKOnly, MsgTitle
ElseIf LenderIDFound = False Then
MsgText = &quot;Lender ID not found.&quot;
MsgTitle = &quot;Error - Data not found&quot;
MsgBox MsgText, vbCritical + vbOKOnly, MsgTitle
End If
End If

End Sub

Public Sub InsertTemplateTables()

Dim i As Integer
Dim MyActiveWorkbook As String
Dim Found1 As Boolean
Dim Found2 As Boolean
Dim MsgText1 As String

MyActiveWorkbook = ActiveWorkbook.Name
Found1 = False
Found2 = False

'CHECK FOR EXISTING SHEETS AND IF FOUND
'SEND MESSAGE TO USER
For i = 1 To Sheets.Count
If Sheets(i).Name = &quot;Export&quot; Then
Found1 = True
End If
Next i

For i = 1 To Sheets.Count
If Sheets(i).Name = &quot;Lender ID&quot; Then
Found2 = True
End If
Next i

If Found1 = False Then
Windows(&quot;LROLExportVBA.xls&quot.Activate
Sheets(&quot;Export&quot.Copy After:=Workbooks(MyActiveWorkbook).Sheets(Workbooks(MyActiveWorkbook).Sheets.Count)
Sheets(&quot;Export&quot.Name = &quot;Export&quot;
Sheets(&quot;Export&quot.Unprotect password:=&quot;ccpace&quot;
Else
MsgText1 = &quot;The Export sheet already exists in this file and was not created.&quot;
End If

If Found2 = False Then
MsgText = &quot;Enter the Lender ID&quot;
MsgTitle = &quot;Enter Lender ID&quot;
LenderID = InputBox(MsgText, MsgTitle)

Windows(&quot;LROLExportVBA.xls&quot.Activate
Sheets(&quot;Lender ID&quot.Copy After:=Workbooks(MyActiveWorkbook).Sheets(Workbooks(MyActiveWorkbook).Sheets.Count)
'PROTECT LENDER ID WORKSHEET
ActiveSheet.Unprotect password:=&quot;ccpace&quot;
Range(&quot;B3&quot = LenderID
ActiveSheet.Protect password:=&quot;lender&quot;, DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
MsgText1 = MsgText1 & Chr(13) & &quot;The Lender ID sheet already exists in this file and was not created.&quot;
End If

If Found1 = True Or Found2 = True Then
MsgBox MsgText1, vbInformation + vbOKOnly, &quot;Sheet already exists&quot;
End If

End Sub

Public Sub Auto_open()

Set MyMenuItem1 = CommandBars(&quot;Worksheet Menu Bar&quot
With MyMenuItem1
.Controls.Add(Type:=msoControlPopup).Caption = &quot;Export&quot;
End With
Set MySubMenuItem1 = CommandBars(&quot;Worksheet Menu Bar&quot.Controls(&quot;Export&quot
With MySubMenuItem1
.Controls.Add(Type:=msoControlButton, Id:=2949, Before:=1).Caption = &quot;Export to TXT&quot;
.Controls(&quot;Export to TXT&quot.OnAction = &quot;StartExport&quot;
End With
' Set MySubMenuItem2 = CommandBars(&quot;Worksheet Menu Bar&quot.Controls(&quot;Export&quot
' With MySubMenuItem2
' .Controls.Add(Type:=msoControlButton, Id:=2949, Before:=1).Caption = &quot;Insert Template Tables&quot;
' .Controls(&quot;Insert Template Tables&quot.OnAction = &quot;InsertTemplateTables&quot;
' End With
End Sub

Public Sub Auto_close()
Dim i As Integer
i = 1
Do Until CommandBars(&quot;Worksheet menu bar&quot.Controls.Count = 10
If CommandBars(&quot;Worksheet menu bar&quot.Controls(i).Caption = &quot;Export&quot; Then
CommandBars(&quot;Worksheet menu bar&quot.Controls(i).Delete
i = i - 1
End If
i = i + 1
Loop
End Sub

 

[Dreamboat]

Well, ya know what? We're gonna have to pray for a visit from DarkSun or JVFriederick, RickSpr, or Simon. Hang tight. Far too difficult for me. The only Dim I do is Dim Sum. (It's chinese food)
techsupportgirl@home.com

http://www.WeDoManuals.com

Brainbench MVP for Microsoft Word at

http://www.brainbench.com

 

[JVFriederick]

Hey, I steered away from this one a loooong time ago !


Seems to me that just about anything in the Autpen sub triggers Excel into thinking something has changed.

However, if closing a file is under control of a macro,

Windows(&quot;File2Close.xls&quot.Activate ' The one you want
ThisWorkbook.Saved = True ' Set the Excel trigger off
ActiveWorkbook.Close (False) ' Don't ask me

--> Note : That includes YOUR latest edits, so save prior to testing !!!!!