SendKeys funktioniert von UF aus nicht
01.04.2005 10:31:28
UF
nach langem Experimentieren und mit Infos aus dem netz habe ich es geschafft eine Prozedur zu erstellen womit man große Tabellen als jpg auf der Festplatte speichern kann ohnen den üblichen Verlust von Formatierungen, etc. beim übliche GIF Export per VBA. Die Tabelle ist als Shape mit dem Namen ("Picture 1") im aktiven Blatt sichtbar.
Im Grunde genommen übergebe ich die Aktionen via SendKeys an den Photoeditor. Das funktioniert auch soweit gut solange die Prozedur von einem Modul aus gestartet wird. Bin ich jedoch in einer UF und starte via CommandButton, dann scheint der Focus nicht mehr richtig zu funktionieren und das Bild wird nicht in den Photoeditor eingefügt.
Sub PhotoEditor()
On Error Resume Next
Application.DisplayAlerts = False
Dim appident As Integer
Dim l_returnpause As String
Dim quellpfad As String
quellpfad = ThisWorkbook.Path & "\Results\01"
ActiveSheet.Shapes("Picture 1").Select
ActiveSheet.Shapes("Picture 1").Copy
'Starten des Programms PhotoEditor und den Fokus darauf setzen
appident = Shell("C:\Programme\Gemeinsame Dateien\Microsoft Shared\PhotoEd\PHOTOED.EXE", 2)
AppActivate appident
'Als neues Bild einfügen im PhotoEditor
SendKeys "%Bf", True
SendKeys "{DOWN 5}", True
SendKeys "{ENTER}", True
AppActivate appident
'Abspeichern der eingeladenen Datei als jpg-Typ
SendKeys "%Du", True
SendKeys quellpfad, True
SendKeys "{ENTER}", True
AppActivate appident
l_returnpause = pause(5)
'PhotoEditor schliessen
SendKeys "%D", True
SendKeys "{up 1}", True
SendKeys "{ENTER}", True
End Sub
Function pause(wartesekunden As Integer) As String
'Dieser Funktion wird eine Wartezeit in Sekunden (Ganzzahl)
'angegeben.
Dim l_zeit As Double
Dim l_wartezeit As Double
Dim l_deltazeit As Double
l_zeit = CDbl(Time)
l_wartezeit = (1 / 86400) * wartesekunden '86400 = 24*3600
Do
l_deltazeit = Time - l_zeit
If l_deltazeit > l_wartezeit Then
Exit Do
End If
Loop
pause = "Pause beendet!"
End Function