我需要將 Excel 中的檔案數字化。使用以下宏，我設法在掃描結束時打開一個對話框，但使用擴展名 xlsm，我需要通過選擇檔案名和帶有 jpeg 擴展名的檔案夾來保存我掃描的 jpeg 影像。
Private Sub CommandButton2_Click()
Dim FinestraDiDialogo As Object
Dim Immagine As Object
Set scansione = CreateObject("WIA.CommonDialog")
Set Immagine = CreateObject("WIA.ImageFile")
Do
Set Immagine = scansione.ShowAcquireImage(ScannerDeviceType, ColorIntent, MaximizeQuality)
Immagine.SaveAs Application.Dialogs(xlDialogSaveAs).Show
Loop Until MsgBox("Procedo ad una nuova scansione? ", vbYesNo vbQuestion, "Scansione
documento") = vbNo
End Sub
uj5u.com熱心網友回復：
Application.GetSaveAsFilename 是你的朋友 - 因為你可以將擴展名傳遞給它
對于這些場合，我使用了一個通用函式，您可以將默認路徑/檔案名和擴展名傳遞給它。它回傳完整的檔案名或空字串 - 如果用戶取消對話框
Public Function getSaveAsFilenameFromUser(Optional initialFileOrPath As String, Optional fileExtension As String) As String
Dim fileFilter As String
'e.g. jpeg (*.jpeg), "*.jpeg" for fileExtension jpeg
fileFilter = fileExtension & " (*." & fileExtension & "), ""*." & fileExtension & """"
Dim varResult As Variant
varResult = Application.GetSaveAsFilename(initialFileOrPath, fileFilter)
If varResult <> False And LenB(varResult) > 0 Then
getSaveAsFilenameFromUser = varResult
End If
End Function
因為我更喜歡在點擊事件中沒有業務邏輯，所以我會scanSaveImage在普通模塊中創建一個通用的-routine，然后呼叫getSaveAsFilenameFromUser-function。
此外，我將為掃描變數設定一些默認常量。
基于https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-icommondialog-showacquireimage我想你可以使用以下默認值
Option Explicit
'adjust these values to your needs
Private Const defaultPath As String = "D:\ScannedImages\"
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-wiadevicetype
Private Const defaultScannerDeviceType As long = 1 'ScannerDeviceType
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-wiaimageintent
Private Const defaultColorIntent As long = 0 'UnspecifiedIntent
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-wiaimagebias
Private Const defaultQuality As long = 131072 'MaximizeQuality
Public Sub scanSaveImage(Optional ScannerDeviceType As long = defaultScannerDeviceType, _
Optional ColorIntent As long = defaultColorIntent, _
Optional Quality As long = defaultQuality)
Dim scansione As Object, Immagine As Object
Set scansione = CreateObject("WIA.CommonDialog")
Dim fullFilename As String
Do
Set Immagine = scansione.ShowAcquireImage(ScannerDeviceType, ColorIntent, Quality)
fullFilename = getSaveAsFilenameFromUser(defaultPath, "jpeg")
If fullFilename <> vbNullString Then
Immagine.SaveAs fullFilename
End If
Loop Until MsgBox("Procedo ad una nuova scansione? ", vbYesNo vbQuestion, "Scansione documento ") = vbNo
End Sub
你的onclick-Routine 看起來像這樣
Private Sub CommandButton2_Click()
scanSaveImage
End Sub
附帶優勢：每當有人進入 onClick 事件時 - 他或她會立即了解這里發生的事情 - 無需閱讀多行代碼。順便說一句：如果您將按鈕重命名為例如 cmdScanSaveImage 它也會增強代碼的可讀性
uj5u.com熱心網友回復：
我嘗試運行修改后的宏，但是當我去檢查檔案夾時，我找不到任何jpg檔案，我錯在哪里
`
Private Sub CommandButton1_Click()
Dim FinestraDiDialogo As Object
Dim Immagine As Object
Set scansione = CreateObject("WIA.CommonDialog")
Set Immagine = CreateObject("WIA.ImageFile")
Do
Set Immagine = scansione.ShowAcquireImage(ScannerDeviceType, ColorIntent, MaximizeQuality)
Call getSaveAsFilenameFromUser(, "JPG")
Loop Until MsgBox("Vuoieseguire una nuova scansione? ", vbYesNo vbQuestion, "Scansione documento ") = vbNo
End Sub
Public Function getSaveAsFilenameFromUser(Optional initialFileOrPath As String, Optional fileExtension As String) As String
Dim fileFilter As String
'e.g. jpeg (*.jpeg), "*.jpeg" for fileExtension jpeg
fileFilter = fileExtension & " (*." & fileExtension & "), ""*." & fileExtension & """"
Dim varResult As Variant
varResult = Application.GetSaveAsFilename(initialFileOrPath, fileFilter)
If varResult <> False And LenB(varResult) > 0 Then
getSaveAsFilenameFromUser = varResult
End If
End Function`
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/372603.html