Question

我有一个VBA代码强制保存为对话框，在尝试保存xltm时显示默认保存类型为xlsm。如果代码不正确，请查看附带的代码并纠正我

Application.EnableEvents = False 
Application.DisplayAlerts = False 
If SaveAsUI = True Then 
    bInProcess = True 
'The following statements shows the save as dialog box with default path
    Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)
    FileSaveName.InitialFileName = ThisWorkbook.Name
    FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
    FileSaveName.Title = "Save As"
    intchoice = FileSaveName.Show
    If intchoice = 0 Then
    Else
        FileSaveName.Execute
    End If
Else 'Normal Save 
    bInProcess = True 
    Cancel = True
    ThisWorkbook.Save 
End If
Application.EnableEvents = True
Application.DisplayAlerts = True

上述代码在尝试使用（ctrl + s）保存时工作正常。如果我试图关闭excel关闭窗口选项。 Excel显示默认的另存为弹出窗口。如果我点击＆＃34;保存＆＃34;保存为弹出窗口的选项，不调用workbook_beforesave事件（显示另存为对话框，默认数据类型从xlsm更改为xls）。我不知道自己犯了什么错误？请帮我摆脱这个..

提前致谢!!!

Answer 1

您需要将代码放在这些行之间

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

Answer 2

重新阅读并进行更多测试后，我了解到您的问题中的代码已经在您创建的Workbook_BeforeSave事件中。你得到的第一个答案实际上是正确的方向，你需要在Workbook_BeforeClose事件中加入额外的代码来处理右上角的X.

你想要的是一个非常棘手的组合，很难在Excel中实现。其原因有几个方面。如果使用右上角X关闭工作簿，则会触发Workbook_BeforeClose，该文件应在该事件中关闭。如果由于某种原因用户取消关闭，这将给你另一个意外的状态，当再次按下X时，似乎没有再次触发Workbook_BeforeClose，但现在触发了Workbook_BeforeSave（内置版本）。

这是一个让你开始实现xltm保存的开始，但正如所说的那样，当你强制用户保存工作簿并退出或者不保存但仍然退出时，它将会受到限制工作簿。它有点脏（转到标签等），但你得到我的漂移。

Excel中有许多关闭/保存组合，很难捕捉到所有正确的组合，因此您可能希望决定完全不同的处理...

$filename = 'images/01.png';
$bgFilename = 'images/background.png';
$im = imagecreatefrompng($filename);
$bg = imagecreatefrompng($bgFilename);
$out = imagecreatetruecolor(imagesx($im), imagesy($im));
$transColor = imagecolorallocatealpha($out, 254, 254, 254, 127);
imagefill($out, 0, 0, $transColor);

for ($x = 0; $x < imagesx($im); $x++) {
    for ($y = 0; $y < imagesy($im); $y++) {
        $pixel = imagecolorat($im, $x, $y);
        $bgPixel = imagecolorat($bg, $x, $y);

        $red = ($pixel >> 16) & 0xFF;
        $green = ($pixel >> 8) & 0xFF;
        $blue = $pixel & 0xFF;
        $alpha = ($pixel & 0x7F000000) >> 24;
        $colorHSL = RGBtoHSL($red, $green, $blue);

        if ((($colorHSL[0]  >= $colorToReplace[0] - $hueAbsoluteError) && ($colorToReplace[0] + $hueAbsoluteError) >= $colorHSL[0])){
            // Instead of taking the replacementColor
            /* $color = HSLtoRGB($replacementColor[0], $replacementColor[1], $colorHSL[2]); */
            /* $red = $color[0]; */
            /* $green= $color[1]; */
            /* $blue = $color[2]; */
            // We just take colors from the backround image pixel
            $red = ($bgPixel >> 16) & 0xFF;
            $green = ($bgPixel >> 8) & 0xFF;
            $blue = $bgPixel & 0xFF;
        }

        if ($alpha == 127) {
            imagesetpixel($out, $x, $y, $transColor);
        }
        else {
            imagesetpixel($out, $x, $y, imagecolorallocatealpha($out, $red, $green, $blue, $alpha));
        }
    }
}
imagecolortransparent($out, $transColor);
imagesavealpha($out, TRUE);
header('Content-type: image/png');
imagepng($out);

Answer 3

感谢大家的帮助。我找到了解决方案。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

StartQuestion:
Cancel = True
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
     Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
         vbYesNoCancel + vbExclamation)
         Case Is = vbYes
             Call CustomSave(vbYes)
             If cancelclicked = False Then
                ThisWorkbook.Saved = True
             Else
                GoTo StartQuestion
             End If
         Case Is = vbNo
             ThisWorkbook.Saved = True
         Case Is = vbCancel
             Exit Sub
     End Select
End With
Cancel = False
End Sub

Sub CustomSave(ans As Long)
Dim MinExtensionX
Dim Arr() As Variant
Dim lngLoc As Variant
Dim events As Boolean
Dim alerts As Boolean
If ActiveWorkbook.Saved = True Then
     Cancel = False
Else
     events = Application.EnableEvents
     alerts = Application.DisplayAlerts

     Application.EnableEvents = False
     Application.DisplayAlerts = False

StartQuestion:
    Select Case ans
    Case Is = vbYes         ' user chose Yes save current workbook
        MinExtensionX = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") + 1)
        Arr = Array("xlsx", "xlsm", "xlsb", "xls", "xml", "mht", "mhtml", "htm", "html", "xltx", "xltm", "xlt", "txt", "csv", "prn", "dif", "slk", "xlam", "xla", "pdf", "xps", "ods") 'define which extensions you want to allow
        On Error Resume Next
        lngLoc = Application.WorksheetFunction.Match(MinExtensionX, Arr(), 0)
        If IsEmpty(lngLoc) Then '
            'The following statements shows the save as dialog box with default path
             Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)

             FileSaveName.InitialFileName = ThisWorkbook.Name
             FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
             FileSaveName.Title = "Save As ... "

             intchoice = FileSaveName.Show
             If intchoice = 0 Then
                cancelclicked = True
             Else
                FileSaveName.Execute
             End If
        Else
            ThisWorkbook.Save
        End If
 End Select
 End If
 End Sub

workbook_beforesave事件未触发

3 个答案: