在VBA中隐藏图片压缩对话框(Excel 2010)

Question

我使用宏在Excel 2010中自动压缩图片，宏会打开一个对话框和发送键，最终用户可以看到它(半秒)，我想隐藏它。请帮帮我！

这是我的宏：

Sub compression()
Application.SendKeys "%w~"
Application.CommandBars.ExecuteMso "PicturesCompress"
End Sub

我已经试过了：

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

但它们似乎不起作用。

@TomPreston这是我的全部代码，我希望用户双击单元格类型在评论中插入图片，但图片必须压缩以保持文件的大小！

我在sendkey和num lock方面也有问题，如果有人能在这方面帮助我的话(见下文)：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, [v:v]) Is Nothing Then

    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
             .AllowMultiSelect = False
             .InitialFileName = CurDir
             .Filters.Clear
             .Filters.Add Description:="Images", Extensions:="*.png;*.jpg;*.jpeg;*.gif", Position:=1
             .Title = "Choose image"

             If .Show = -1 Then TheFile = .SelectedItems(1) Else TheFile = 0
        End With

    If TheFile = 0 Then
    MsgBox ("No image selected")
    Exit Sub
    End If

    ActiveCell.ClearComments
    Selection.AddComment
    PreviousCell = ActiveCell.Address
    ActiveCell.Comment.Shape.Fill.UserPicture TheFile

    NumLockState = GetKeyState(VK_NUMLOCK)

    Application.SendKeys "%a~"
    Application.CommandBars.ExecuteMso "PicturesCompress"

    If NumLockState <> GetKeyState(VK_NUMLOCK) Then
    Application.SendKeys ("%{Numlock}"), True
    End If

    ActiveCell.Comment.Visible = True

    CommentAdded = True

    Application.ScreenUpdating = True

    End If

    End Sub

用户可以更改图片的大小，更改选择后，注释将隐藏。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If CommentAdded = True Then

Range(PreviousCell).Comment.Visible = False

PreviousCell = ""

CommentAdded = False

End If

End Sub

以下是变量：

Public CommentAdded As Boolean
Public PreviousCell As String
Public Const VK_NUMLOCK = &H90
Public Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Long

Answer 1

如果您只想隐藏闪烁效果，请使用以下命令：

Sub compression()
Application.ScreenUpdating = False
Application.SendKeys "%w~" Application.CommandBars.ExecuteMso "PicturesCompress"
Application.ScreenUpdating = True
End Sub