At the time a file is opened, I'd like an input box to pop up that states, "This Tract Is:" and the editable text in the input box (the white box) is referenced from a cell in the just opened workbook - always cell A1. Then the user can edit any text he needs to, press "okay" and the file will automatically save using what the user typed (or edited from the A1 cell reference) in the input box as the file save as name, after "okay" is pressed. I believe I know the VBA to save, but if anyone sees any errors, feel free to comment.
Private Sub SaveWorkbookAsNewFile(NewFileName As String) Dim ActSheet As Worksheet Dim ActBook As Workbook Dim CurrentFile As String Dim NewFileType As String Dim NewFile As String Application.ScreenUpdating = False ' Prevents screen refreshing. CurrentFile = ThisWorkbook.FullName NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ "Excel Files 2007 (*.xlsx), *.xlsx," & _ "All files (*.*), *.*" NewFile = Application.GetSaveAsFilename( _ InitialFileName:=NewFileName, _ fileFilter:=NewFileType) If NewFile <> "" And NewFile <> "False" Then ActiveWorkbook.SaveAs Filename:= NewFile, _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook Workbooks.Open CurrentFile ActBook.Close End If Application.ScreenUpdating = TrueEnd Sub
***Uh, that didn't paste how I thought it would...
Private Sub SaveWorkbookAsNewFile(NewFileName As String) Dim ActSheet As Worksheet Dim ActBook As Workbook Dim CurrentFile As String Dim NewFileType As String Dim NewFile As String Application.ScreenUpdating = False ' Prevents screen refreshing. CurrentFile = ThisWorkbook.FullName NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ "Excel Files 2007 (*.xlsx), *.xlsx," & _ "All files (*.*), *.*" NewFile = Application.GetSaveAsFilename( _ InitialFileName:=NewFileName, _ fileFilter:=NewFileType) If NewFile <> "" And NewFile <> "False" Then ActiveWorkbook.SaveAs Filename:= NewFile, _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Set ActBook = ActiveWorkbook Workbooks.Open CurrentFile ActBook.Close End If Application.ScreenUpdating = TrueEnd Sub
***Uh, that didn't paste how I thought it would...
Last edited: