VBA: Bild öffnen (done) und dann als pdf drucken

[markusf1895]

Hallo zusammen,

danke fürs Interesse.


Suche eine Möglichkeit ein Bild per Excel VBA code in der Anwendung als pdf zu drucken.

ZUM ÖFFNEN des Bildes:

Code:

Private Const MAX_PATH = 260

'Icon IDs
Private Const MB_ICONHAND As Long = &H10&

'Button IDs
Private Const MB_RETRYCANCEL As Long = &H5&

'Msgbox style IDs
'modality
Private Const MB_TOPMOST As Long = &H40000

'wLanguageId parameter IDs
Private Const LANG_ENGLISH As Long = &H9

'Return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

'APIs
Private Declare Function GetShortPathName Lib "kernel32" Alias _
   "GetShortPathNameA" ( _
   ByVal lpszLongPath As String, ByVal lpszShortPath As String, _
   ByVal cchBuffer As Long) As Long
 
Private Declare Function GetDesktopWindow Lib "user32" () _
   As Long
   
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
   "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
   As String, ByVal lpFile As String, ByVal lpParameters _
   As String, ByVal lpDirectory As String, ByVal nShowCmd _
   As Long) As Long
   
Private Declare Function GetSystemDirectory Lib "kernel32" _
   Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long
   
Private Declare Function MessageBoxEx Lib "user32" _
   Alias "MessageBoxExA" _
   (ByVal hwnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal uType As Long, _
   ByVal wLanguageId As Long) As Long
   
   
   
   
   
   
   
   
   
   ' liefert zu einem ErrorCode der API ShellExecute die passende ErrorMessage
Private Function SE_ErrMessage(ByVal lngErrCode&) As String

   Select Case lngErrCode
       Case 0:     SE_ErrMessage = "Zuwenig Speicher, ausführbare Datei war zerstört, Relokationswerte waren ungültig"
       Case 2:     SE_ErrMessage = "Datei wurde nicht gefunden."
       Case 3:     SE_ErrMessage = "Verzeichnis wurde nicht gefunden."
       Case 5:     SE_ErrMessage = "Fehler beim gemeinsamen Zugriff auf eine Datei im Netz oder Fehler beim Zugriff auf eine gesperrte Datei im Netz."
       Case 6:     SE_ErrMessage = "Bibliothek forderte separate Datensegmente für jede Task an."
       Case 8:     SE_ErrMessage = "Zuwenig Speicher, um die Anwendung zu starten."
       Case 10:    SE_ErrMessage = "Falsche Windows-Version."
       Case 11:    SE_ErrMessage = "Ungültige ausführbare Datei. Entweder keine Windows-Anwendung oder Fehler in der EXE-Datei."
       Case 12:    SE_ErrMessage = "Anwendung für ein anderes Betriebssystem."
       Case 13:    SE_ErrMessage = "Anwendung für MS-DOS 4.0."
       Case 14:    SE_ErrMessage = "Typ der ausführbaren Datei unbekannt."
       Case 15:    SE_ErrMessage = "Versuch, eine Real-Mode-Anwendung (für eine frühere Windows-Version) zu laden."
       Case 16:    SE_ErrMessage = "Versuch, eine zweite Instanz einer ausführbaren Datei mit mehreren Datensegmenten die nicht als nur lesbar gekennzeichnet waren, zu laden."
       Case 19:    SE_ErrMessage = "Versuch, eine komprimierte ausführbare Datei zu laden.' + #13 + 'Die Datei muß dekomprimiert werden, bevor sie geladen werden kann."
       Case 20:    SE_ErrMessage = "Ungültige dynamische Linkbibliothek (DLL).' + #13 + 'Eine der DLLs, die benötigt wurde, um die Anwendung auszuführen, war beschädigt."
       Case Else:  SE_ErrMessage = "Ein Unbekannter Fehler ist aufgetreten."
   End Select
End Function

' versucht per API ShellExecute die mit der Datei verknüpfte Anwendung zu starten
' Wenn die Dateierweiterung noch nicht bekannt ist, wird der "Öffnen mit..."-Dialog angezeigt
' ansonsten eine entsprechende Fehlermeldung
' Alles in allem das vertraute Windows-Look´n Feel!
Public Function ÖffneDatei(ByRef sDateiPfad As String) As Boolean
   
   Dim path$, Err&
   Dim sMessage$, sTitle$, dwFlags$
   Dim sDirectory$, lRet&, DeskWin&
   
Retry:
   
   ÖffneDatei = True
   
   ' Versuch, die mit der Datei verknüpfte Anwendung zu starten
   path = Space(MAX_PATH)
   Call GetShortPathName(sDateiPfad, path, MAX_PATH)
   DeskWin = GetDesktopWindow()
   Err = ShellExecute(DeskWin, "Open", path, "", vbNullString, 1)
   
   '# Fehlerbehandlung #
   'Wenn die Dateierweiterung noch nicht bekannt ist...
   'wird der "Öffnen mit..."-Dialog angezeigt
   If Err = "31" Then
   
       sDirectory = Space(MAX_PATH)
       lRet = GetSystemDirectory(sDirectory, Len(sDirectory))
       sDirectory = Left(sDirectory, lRet)
       Call ShellExecute(DeskWin, vbNullString, _
         "RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL " & _
         path, sDirectory, vbNormalFocus)
   
   
   'Sonstige Fehler
   ElseIf Err <> "42" Then
       
       ÖffneDatei = False
       
       sMessage = sDateiPfad & " kann nicht geöffnet werden." & vbLf & SE_ErrMessage(Err)
       sTitle = "Explorer - " & path
       dwFlags = MB_ICONHAND Or MB_RETRYCANCEL Or MB_TOPMOST
       Select Case MessageBoxEx(Screen.ActiveForm.hwnd, _
                                sMessage, _
                                sTitle, _
                                dwFlags, _
                                LANG_ENGLISH)
                               
           Case IDOK:
           Case IDCANCEL:
           Case IDABORT:
           Case IDRETRY: GoTo Retry
           Case IDIGNORE:
           Case IDYES:
           Case IDNO:
       End Select
   End If
End Function









Sub openPicture()

Dim bResult As Boolean
bResult = ÖffneDatei("C:\Users\user\Desktop\Unbenannt1.jpg")

End Sub

https://www.ms-office-forum.net/forum/sh...p?t=200444

Wie stelle ich es nun an das Bild zu drucken. (Tastenbefehl: Strg + P)

Zunächst eine Lösung mit den Standard-Drucker wäre schon toll, mit Auswahl/Eingabe noch besser. (Tastenbefehl: Enter)

Namen Eingabe wäre hilfreich.


Dann speichern und das wäre schon alles^^.

[schauan]

Hallöchen,

wenn Du das Bild mit einer anderen Anwendung öffnest, musst Du schauen, wie Du selbige nach dem Öffnen steuerst.
Womit willst Du denn die pdf erzeugen?
Wenn Du keine spezielle Anwendung hast müsstest Du das eventuell aus Excel heraus tun indem Du das Bild lädst und dann als pdf speicherst.

Ich vermute auf Grund der Fragestellung, dass Du einen pdf-Drucker installiert hast. Welcher ist das?

[markusf1895]

Naja, habs vollbraucht. quick

Code:

Sub openPictureANDprintASpdf(ByVal path As String, ByVal DATAtype As String)
'Dim path As String: path = "C:\Users\Markus\Desktop\Unbenannt1.jpg"
'Dim DATAtype As String: DATAtype = "unbekannt1"

Dim appSh As Object
Set appSh = CreateObject("Shell.Application")
appSh.Open (path) ' "C:\Temp\KLE.jpg"

DoEvents
lnghWnd = GetForegroundWindow
Set appSh = Nothing


Sleep 2000
Application.SendKeys "^p"

Dim i As Integer: For i = 1 To 7
Sleep 400
Application.SendKeys "{TAB}"
Next
Sleep 400
Application.SendKeys "~"

Sleep 300
For i = 1 To Len(DATAtype)
Sleep 500
Application.SendKeys Mid(DATAtype, i, 1)
Next



Sleep 200
Application.SendKeys "~"
Sleep 400

Application.SendKeys "{TAB}"
Sleep 200
Application.SendKeys "~"
Sleep 2000

If lnghWnd > 0 Then Call SendMessage(lnghWnd, WM_CLOSE, 0, 0)
End Sub

wollte in Zukunft aber ebenfalls Handschriften auslesen.

Nun also eine Shell mit einer dieser Anwendungen.

Link entfernt

Suche die Möglichkeit ein fotografierten handschriftlichen Text (ordentlich, aber auch Schreibschrift, wieOonenote oder Evernote) in irgendeinen erdenklichen Text umzuwandeln.
Würde so vieles im Leben vereinfachen.

Bin für jeden Hinweis Dankbar, allein welches der Programme empfiehlt ihr?

Ah, und es ist der "Microsoft print to pdf".

[schauan]

Hallöchen,

was meinst Du mit

Nun also eine Shell mit einer dieser Anwendungen.

Willst Du Geld ausgeben? Ich hatte früher Omnipage, das ist glaube immer noch Marktführer. Gibt's derzeit für 69€
Von Abby Finereader gibt's eine Kostenlose Testversion.

[markusf1895]

Danke schon mal,

aber konntest du noch etwas konkreter werden.
Mit einer dieser Programm kann ich also einfach ein Foto meiner Handschrift aufnehmen und es somit digitalisieren?

[schauan]

Hallöchen,

ich hatte angenommen, weil Du handschriftlichen Text und Schreibschrift getrennt aufgeführt hast, Du meinst mit einem von beiden Druckbuchstaben. Wenn das annähernd der Maschinenschrift entspricht, könnte es mit "normaler" OCR funktionieren. Ansonsten hattest Du ja selber schon auf OneNote oder Everote hingewiesen, das würde ich noch um MS Office Lens ergänzen