프롬프트 없이 새 Excel 문서를 매크로가 없는 워크북으로 저장
저는 Excel 2010을 사용하고 있습니다.이 템플릿을 사용하여 새 문서를 만들 때 자동으로 새로 고치도록 설정된 텍스트 파일에 대한 데이터 연결이 있는 Excel 매크로 사용 가능 템플릿이 있습니다.
다음 매크로는 새 문서를 저장하기 전에 데이터 연결을 제거하기 위해 "이 워크북" 오브젝트 내에 있습니다.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
End Sub
사용자가 저장 아이콘을 클릭하거나 ctrl+S를 누르고 파일 이름을 입력한 다음 저장을 클릭하여 매크로가 없는 Excel 워크북(기본 및 필수 파일 형식)으로 저장하면 다음과 같은 메시지가 표시됩니다.
다음 기능은 매크로가 없는 워크북에 저장할 수 없습니다.
VB 프로젝트
이러한 기능을 사용하여 파일을 저장하려면 아니요를 클릭한 다음 파일 형식 목록에서 매크로 사용 파일 형식을 선택합니다.
매크로가 없는 워크북으로 계속 저장하려면 예를 클릭합니다.
이 메시지가 표시되지 않도록 하고 사용자가 매크로가 없는 워크북을 계속하기를 원한다고 Excel이 가정할 수 있습니까?
저는 모든 곳을 검색했고 Excel이 이 메시지를 발생시킬 VB 프로젝트가 없도록 자체를 제거하는 워크북 개체에 코드를 추가할 수 있다는 것을 이해했습니다. 그러나 이 경우 각 사용자는 신뢰 센터 설정(VBA 프로젝트 개체 모델에 대한 신뢰 액세스 권한)을 변경해야 합니다.
다음을 사용하는 방법에 대한 제안도 보았습니다.
Application.DisplayAlerts = False
하지만 이것을 작동시킬 수 없습니다.모든 사용 예는 문서 저장을 처리하는 서브 내에 있는 것처럼 보이지만, 내 상황에서는 문서가 기본값인 비바 방식으로 저장되기 전에 BeforeSave 서브가 종료되어 작동하지 않습니다.
서브가 종료된 후/저장이 실제로 발생하기 전에 이 속성이 기본 True로 재설정됩니까?
쓸데없는 말을 해서 죄송합니다. VBA에 대한 제 경험은 매우 제한적입니다.
Excel 2010에서는 테스트할 수 없지만 적어도 2016년에는 정상적으로 작동합니다.
Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:\he\Path\you\prefer\"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
한번 해보라구요.
다른 접근 방식...템플릿이 로드되면 사용자에게 다음과 같이 저장하도록 요구합니다(유사한 상황의 워크북/템플릿이 있습니다...).이렇게 하면 사용자의 문서 폴더가 열리지만 원하는 위치에 저장하도록 조정할 수 있습니다.
이 워크북 모듈 안에 다음을 넣습니다.
Option Explicit
Private Sub Workbook_Open()
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Edit1: 기본 템플릿 이름을 사용하여 if 문을 추가하면 다음과 같이 저장하라는 메시지가 표시되지 않습니다.
Option Explicit
Private Sub Workbook_Open()
If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End If
End Sub
이 답변에 대해, 저는 Excel 매크로 지원 템플릿에서 xltm 파일을 의미한다고 가정합니다.또한 "새 문서"를 의미하는 것은 사용자가 xtlm 파일을 두 번 클릭할 때 생성되는 문서인 것 같습니다(따라서 이 새 파일은 아직 저장되지 않았기 때문에 위치가 없습니다).
문제를 해결하려면 사용자 지정 다른 이름으로 저장 창을 사용할 수 있습니다.Application.GetSaveAsFilename)에서 파일을 저장할 때더 잘 할 수 있도록 Workbook_BeforeSave이벤트 매크로가 호출됩니다.
구현 방법은 다음과 같습니다.
1 - 이 코드를 새 모듈로 복사합니다.
Option Explicit
Sub SaveAsCustomWindow()
Const C_PROC_NAME As String = "SaveAsCustomWindow"
Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
Dim UserInput1 As Variant, UserInput2 As Variant
Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
Dim strFilename As String, strFilePath As String
'To avoid Warning when overwriting
Application.DisplayAlerts = False
'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
Application.EnableEvents = False
On Error GoTo ErrHandler
'Customizable section
strDefaultName = ThisWorkbook.Name
strPreferedFolder = Environ("USERPROFILE")
Do While isWorkbookClosed = False
Do While isFileClosed = False
Do While isValidName = False
UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")
If UserInput1 = False Then
GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
Else
strFullFileName = UserInput1
End If
strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
strDefaultName = strFilename
strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
strPreferedFolder = strFilePath
'If the file exist, ask for overwrite permission
If Dir(strFullFileName) <> "" Then
UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
If UserInput2 = vbNo Then
isValidName = False
ElseIf UserInput2 = vbYes Then
isValidName = True
ElseIf UserInput2 = vbCancel Then
GoTo ClosingStatements
Else
GoTo ClosingStatements
End If
Else
isValidName = True
End If
Loop
'Check if file is actually open
If isFileOpen(strFullFileName) Then
MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the workbook before saving.", vbExclamation
isValidName = False
isFileClosed = False
Else
isFileClosed = True
End If
Loop
'Check if an opened workbook has the same name
If isWorkbookOpen(strFilename) Then
MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
isValidName = False
isFileClosed = False
isWorkbookClosed = False
Else
isWorkbookClosed = True
End If
Loop
ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook
ClosingStatements:
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrHandler:
Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
"While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
GoTo ClosingStatements
End Sub
Function isFileOpen(ByVal Filename As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open Filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isFileOpen = False
Case 70: isFileOpen = True
End Select
End Function
Function isWorkbookOpen(ByVal Filename As String) As Boolean
Dim wb As Workbook, ErrNo As Long
On Error Resume Next
Set wb = Workbooks(Filename)
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isWorkbookOpen = True
Case Else: isWorkbookOpen = False
End Select
End Function
파트 1에 대한 설명: 이 모든 것이 약간 지나친 것처럼 보일 수 있지만, 잠재적인 오류를 고려하고 설정을 확인하기 위해 여기서 모든 오류 처리가 중요합니다.Application.EnableEvents 에반됨으로 반환됩니다.TRUE 않으면 Excel 프로그램에서 그렇지 않으면 Excel 응용 프로그램에서 모든 이벤트 매크로가 비활성화됩니다.
2 - 호출SaveAsCustomWindow the 프로시저는
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub
기본 SaveAs 창이 표시되지 않도록 하려면 Cancel = True 변수를 설정해야 합니다.또한 if 문은 파일이 저장되지 않은 경우에만 사용자 지정 다른 이름으로 저장 창이 사용되도록 하기 위해 사용됩니다.
질문에 대한 답변:
이 메시지가 나타나지 않게 할 수 있습니까?
예, 용을 합니다.Application.DisplayAlerts
사용자가 매크로가 없는 워크북을 계속하기를 원한다고 Excel이 가정하도록 하는 것이 가능합니까?
하고 문제집, 문제집을 .SaveAs및입력을 (Excel 이트를수사입저장워다합니크을북사여)Path&Filename필요한 형식을 사용합니다.
다음 절차에서는 FileDialog를 사용하여 사용자로부터 경로 및 파일 이름을 캡처한 다음 경고 메시지를 표시하지 않고 파일을 저장합니다.그럼에도 불구하고 몇 가지 설명적인 의견을 추가하였으니, 질문이 있으시면 언제든지 말씀해주세요.
를 음다절복에 합니다.ThisWorkbook모듈:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True 'Prevents repetitive Save
Call Workbook_BeforeSave_ApplySettings_And_Save
End Sub
Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String
Rem Sets FileDialog to capture user input
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialView = msoFileDialogViewDetails
.Title = vbNullString 'Resets default value in case it was changed
.ButtonName = vbNullString 'Resets default value in case it was changed
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub 'User pressed the Cancel Button
sFilename = .SelectedItems(1)
End With
With ThisWorkbook
Do While .Connections.Count > 0
.Connections.Item(.Connections.Count).Delete
Loop
Application.EnableEvents = False 'Prevents repetition of the Workbook_BeforeSave event
Application.DisplayAlerts = False 'Prevents Display of the warning message
On Error Resume Next 'Prevents Events and Display staying disable in case of error
.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook 'Saves Template as standard excel using user input
If Err.Number <> 0 Then
MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
& Err.Description & String(2, vbLf) _
& vbTab & "Process will be cancelled.", _
vbOKOnly, "Microsoft Visual Basic"
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End With
End Sub
언급URL : https://stackoverflow.com/questions/45596268/saving-new-excel-document-as-macro-free-workbook-without-prompt
'programing' 카테고리의 다른 글
| PowerShell을 사용하여 새 라인을 교체하려면 어떻게 해야 합니까? (0) | 2023.08.25 |
|---|---|
| angular cli 프로젝트에 node_modules의 자산을 포함하는 방법 (0) | 2023.08.25 |
| MySQL Workbench에서 글꼴 변경 (0) | 2023.08.25 |
| App_Code에 저장된 Unit Testing ASP.net 웹사이트 프로젝트 코드 (0) | 2023.08.25 |
| phpinfo()는 MySQL을 나타내고, PMA는 마리아를 나타냅니다.DB (0) | 2023.08.25 |