Office 2016 - Excel Macro to Insert Scanned Image direct from Scanner into Worksheet with VBA

Question

Hi All,

I am trying to customise a friends Excel 2016 (64 Bit) to include a macro assigned button to insert a scanned image/document direct from her scanner into the worksheet in a single click. She is disabled and struggles with her hands so a 'single click' function is both desirable and less stressful than working through the usual menu structures saving the image and then inserting as a picture. I have successfully implemented the companion macros into both Word 2016 (64 Bit) and Outlook 2016 (64 Bit) and these function like a charm.

The issue with the Excel Macro appears to be either in the path or the 'Selection.ActiveSheet.Pictures' process as the scanner initialises, the scan is processed (visible in preview window) but fails to insert into the worksheet the highlight remaining boxed around the A1 cell but no image appears :(

I am not especially conversant with VBA and so I have so far been unable to identify which part of the code contains the error preventing the insertion in this case and so resolve the problem. I have consulted both the forum and the wider internet extensively and whilst I was able to adapt the Word and Outlook codes successfully using posts both here and links externally suggested by forum experts I am at a loss as to what is wrong!

This is the adapted code I am using, perhaps someone with greater expertise than myself could either test or suggest how I can modify the code to resolve the problem. (BTW. The end user's scanner documents default to  "D:<Username>\Username's Filing Cabinet\Username's Scanned Documents" in case this is applicable to the issue. Also I have saved the Book1 as a 'Excel Macro Enabled Template' in both the 'customised' Excel template location "D:<Username>\Username's Filing Cabinet\Username's Documents\Office Documents\Excel\Templates" and copied to "C:\Users<Username>\AppData\Roaming\Microsoft\Excel\XLSTART" as suggested in one internet post if that helps).

' Scan for Excel 2016 - 64 Bit

' Based Upon Author: Günter Born www.borncity.de blog.borncity.com

' Implements a Scan function in Excel 2016

Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Function TempPath() As String

  Const MaxPathLen = 256 ' Max length of the path, just as big as possible

  Dim FolderName As String ' Name of the folder

  Dim ReturnVar As Long ' Return Value

  FolderName = String(MaxPathLen, 0)

  ReturnVar = GetTempPath(MaxPathLen, FolderName)

  If ReturnVar <> 0 Then

    TempPath = Left(FolderName, InStr(FolderName, Chr(0)) - 1)

  Else

    TempPath = vbNullString

  End If

End Function

Sub Scan()

'

' Scan Macro, to be invoked in Excel 2016

'

  On Error Resume Next

     Dim objCommonDialog As WIA.CommonDialog

     Dim objImage As WIA.ImageFile

     Dim strDateiname

     ' instantiate Scan WIA objects

     Set objCommonDialog = New WIA.CommonDialog

     Set objImage = objCommonDialog.ShowAcquireImage

    strDateiname = TempPath & "Scan.jpg" ' set temporary file

'     strDateiname = "C:\Users\Public\Pictures" & "Scan.jpg"

     If Not objImage Is Nothing Then

       Kill strDateiname

       objImage.SaveFile strDateiname ' save into temp file

       Selection.ActiveSheet.Pictures strDateiname ' insert into worksheet

       Set objImage = Nothing

     End If

     Set objCommonDialog = Nothing

  '  MsgBox strDateiname  ' test output

End Sub

Many thanks in advance of your kind responses.

Best regards,

PC Pilot

Answer 1

Comment out all of your code and try the sub below.

Andreas.

Sub Scan()

  Dim objCommonDialog As WIA.CommonDialog

  Dim objImage As WIA.ImageFile

  Dim strDateiname As String

  ' instantiate Scan WIA objects

  Set objCommonDialog = New WIA.CommonDialog

  Set objImage = objCommonDialog.ShowAcquireImage

  strDateiname = Environ$("TEMP") & "\Scan.jpg" ' set temporary file

  If Not objImage Is Nothing Then

    If Dir(strDateiname) <> "" Then Kill strDateiname

    objImage.SaveFile strDateiname 'save into temp file

    DoEvents

    ActiveSheet.Shapes.AddPicture _

      strDateiname, False, True, ActiveCell.Left, ActiveCell.Top, -1, -1

  End If

End Sub

Answer 2

Is there any way in which I can get PowerPoint to open with the addin loading on initial start up of PowerPoint (say to Presentation1) as a clean slide with the 'scan' functions (macro) invoked as part of the automated load?

The reason why my "Install.pptm" doesn't work with your AddIn is that it is designed to install an AddIn named "Document Location.ppam" which must be located in the same path. (Do you see "Document Location" inside the TextBox? That's how the code is associated to the AddIn to be installed.)

The 2nd things might be that the AddIn is not located in a trusted location, check the Trusted Locations in the Trust Center.

Andreas.

Answer 3

Hi Andreas,

Thanks again for your rapid response (much appreciated) and for clarifying the install process.

Apologies if I had misunderstood the process, I did apply the install as described but for some reason the "Document Process" and its invoked "'install.pptm'!NewMacros.scan" & "'install.pptm'!NewMacros1.scan" Macros were not listed under Macros in the "Customize Ribbon" 'Commands' option and so could not be added to the Ribbon.

I have added the Addin install path to the Trusted Locations list and yet so far I have been unsuccessful in getting the settings to hold for each re-launch of PowerPoint (to clarify, I have experienced no issue with either Excel or Word in this effect) and when, as an alternate, I select the Install.pptm from the recent documents list in PowerPoint it immediately reports:

"run-time error" 2147188160 (80048240):

Application (unknown member): Invalid Request. There is no active presentation.

And then,

"The Macro cannot be found or has been disabled by your security settings" (Macros enabled by the way)

before repeating,

"run-time error" 2147188160 (80048240):

Application (unknown member): Invalid Request. There is no active presentation.

And finally,

"The Macro cannot be found or has been disabled by your security settings"

The presentation now appears with the F5 install slide. Pressing F5 and then "Install" re-invokes and the Macro is once more listed. I suspect that the behaviour is not as intended and that I am (most likely) doing something wrong.

I would be grateful if you could:

1. Clarify the correct install process step-by-step
2. Clarify whether the behaviour once invoked should be retained as with Excel and Word. 

Many thanks again,

PC Pilot

Answer 4

1. Clarify the correct install process step-by-step

Forget the Install.pptm, the basic "install" for PowerPoint is simply this:

Sub Test()

  Dim A As AddIn

  Set A = Application.AddIns.Add("C:\Whatever\MyAddIn.ppam")

  A.Registered = msoTrue

  A.AutoLoad = msoTrue

  A.Loaded = msoTrue

End Sub

So when you change the path to your AddIn and run the code (with Powerpoint) the AddIn is installed, registered, loaded and auto loads the next time when PowerPoint starts up.

Andreas.

Answer 5

Hi Andreas,

Thanks once again for your input......and so sorry to seem stupid here but I am just not getting this.....remember I am a novice at VBA :(   .....but certainly a willing learner :)

Here I have taken your "Document Location.ppam" as the addin and located it at the root of D: thus my (modified) code reads: 

Sub Test()

  Dim A As AddIn

  Set A = Application.AddIns.Add("D:\Document Location.ppam")

  A.Registered = msoTrue

  A.AutoLoad = msoTrue

  A.Loaded = msoTrue

End Sub

OK so this is what I have done step by step....

1. Opened PowerPoint (Blank Presentation) - Presentation1
2. From 'Developer' tab open VBA editor (Alt F11)
3. Insert Module into the VBA Project
4. Paste the above (modified) code into the module
5. From "Tools" tab select references and tick "Microsoft Windows Image Acquisition Library v2.0"
6. Select "F5" to run code
7. Close and exit PowerPoint
8. Re-open PowerPoint and check

      (a) "Document Location" is added and loaded as a PowerPoint Add-in  - Answer = Yes

      (b) From "File" > "Options" > "Quick Access Toolbar" > "Choose Commands" > "Macros" look for a "Scan Macro" - Answer = NO Macros listed........

What have a missed in my step by step?  or, have I completely misunderstood your response??

Regards once again

PC Pilot