'------------------'' Gem som nyt navn '
'------------------'
'Lukker alle popup vinduer
Dim objLoop As Object
For Each objLoop In VBA.UserForms
If TypeOf objLoop Is UserForm Then Unload objLoop
Next objLoop
Dim varWorkbookName As String
Dim sFileExtension As String
Dim ans As VbMsgBoxResult
Application.EnableEvents = False
varWorkbookName = Application.GetSaveAsFilename(InitialFileName:="", _
filefilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm)", _
FilterIndex:=1)
If varWorkbookName <> "False" Then
sFileExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(varWorkbookName)
sFileExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(varWorkbookName)
varWorkbookName = Left(varWorkbookName, Len(varWorkbookName) - Len(sFileExtension)) & "xlsm"
If Dir(varWorkbookName) <> "" Then
ans = MsgBox(" " & Mid$(varWorkbookName, InStrRev(varWorkbookName, "\") + 1) _
& vbCrLf & " findes allerede." _
& vbCrLf & vbCrLf & " Skal den eksisterende fil erstattes ?", _
vbYesNo + vbInformation, "Bekræft Gem som")
If ans = vbYes Then
Application.DisplayAlerts = False
On Error GoTo FileOpen
ActiveWorkbook.SaveAs Filename:=varWorkbookName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
End If
Else
ActiveWorkbook.SaveAs Filename:=varWorkbookName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End If
Application.EnableEvents = True
Exit Sub
FileOpen:
MsgBox " Filen er åben i et andet vindue." _
& vbNewLine & vbNewLine & " Luk filen og gem igen.", _
vbExclamation, "Fil åben"