Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
512to516
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
512to516
512to516
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Snagit und Excel

Snagit und Excel
07.11.2004 18:46:44
Stefan
Guten Abend miteinander
Ich weiss, die Hoffnung ist sehr, sehr klein. Doch vielleicht hat jemand eine Ahnung oder schon erfolgreich eingerichtet. Ich möchte gerne mit Snagit eine in der UserForm integrierten WebBrowser1 auslesen. Manuell geht das ausgezeichnet. Doch die Automatisierung mittels VBA und DEE (veraltet) ist sehr sehr schwer. Hat jemand eine Ahnung wie das gehen könnte oder sonst ein hilfreichen Hinweis.
Für alles bin ich dankbar.
Grüsse
Stefan
Option Explicit
'MouseClick
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'Mouseposition
Private Declare Function GetCursorPos Lib "user32" (cPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'Snagit
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
'Position
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'Clipboard
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
'Focus
Private Declare Function GetFocus Lib "user32" () As Long

Private Sub cmbHEDOsave_Click()
Dim wHandle As Long
Dim lngOldState As Long
Dim strDatenVorlage As String
Dim strPathWahl As String
Dim strDateiName As String
Dim intI As Integer
Dim SnagType As String
Dim Channel As Long
Dim a$
Dim Response
Dim lResult As Long
Dim Pausenlänge, Start, Ende, Gesamtdauer
Dim hwnd As Long
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.CutCopyMode = False
End With
strDatenVorlage = C:\Daten\Vorlage.xls
strPathWahl = C:\Pictures\
strDateiName = CStr("Hed " & Format(Now, "dd.mm.yy hh:mm:ss")
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
Call CloseClipboard
End If
With WebBrowser1
Do
DoEvents
Loop While .ReadyState <> READYSTATE_COMPLETE
End With
Workbooks.Open strDatenVorlage, False, False
strPathWahl = strPathWahl
lResult = ShellExecute(0, "open", "snagit32", "", "", 0)
'Pause von 2 Sekunde
Pausenlänge = 5      ' Dauer 2s
Start = Timer        ' Anfangszeit setzen.
Do While Timer < Start + Pausenlänge
Debug.Print Ende
'DoEvents    ' Steuerung an andere Prozesse abgeben.
Loop
SnagType = "screen"  'window, screen, client, region
On Error Resume Next
Channel = Application.DDEInitiate(app:="SnagIt", topic:="system")
If Channel = 0 Then
'Response = MsgBox("Could not initiate DDE link with SnagIt", vbExclamation + vbOKOnly, "Microsoft Word")
'GoTo
End If
'If dlg.SnagType = 3 Then
'   WordBasic.DDEExecute Channel, "[esnag(DEF,CLP,MON 70,DEF,0x10)]"
WebBrowser1.SetFocus
Call SetFocusToBrowser(GetFocus)
Dim tPoint As POINTAPI
Dim X As Long, Y As Long, n As Long
X = GetCursorPos(tPoint)
X = tPoint.X - 170
Y = tPoint.Y - 30
n = SetCursorPos(X, Y)
'Klick-Ereignis generieren:
'mouse_event MOUSEEVENT_LEFTDOWN, 0, 0, 0, 0
'mouse_event MOUSEEVENT_LEFTUP, 0, 0, 0, 0
On Error Resume Next
Rem initialize SnagIt and do the capture
Application.DDEExecute Channel, "[set (" + Chr(34) + "profile default" + Chr(34) + ")]"
Application.DDEExecute Channel, "[set (" + Chr(34) + "preview 0" + Chr(34) + ")]"
Application.DDEExecute Channel, "[set (" + Chr(34) + "window hide" + Chr(34) + ")]"
Application.DDEExecute Channel, "[set (" + Chr(34) + "input " + SnagType$ + Chr(34) + ")]"
Application.DDEExecute Channel, "[set (" + Chr(34) + "output clipboard" + Chr(34) + ")]"
hwnd = GetFocus
'mouse_event MOUSEEVENT_LEFTDOWN, 0, 0, 0, 0
'Captures mouse cursor
Application.DDEExecute Channel, "[set (" + Chr(34) + "options 0x01" + Chr(34) + ")]"
'truns on AutoScroll
Application.DDEExecute Channel, "[set (" + Chr(34) + "options 0x10" + Chr(34) + ")]"
Application.DDEExecute Channel, "[esnag(DEF,CLP,GRY,MAX,0x10)]"
'Application.DDEExecute Channel, "[esnag(CHD " & hwnd & ",CLP,MON 70,MAX,0x10)]"
'Application.DDEExecute Channel, "[esnag(WIN 1000 200,CLP,MON 70,MAX,0x10)]"
'Else
'  WordBasic.DDEExecute Channel, "[snag(" + Chr(34) + "" + Chr(34) + ")]"
'End If
'Mausklick links
mouse_event MOUSEEVENT_LEFTDOWN, 0, 0, 0, 0
'SendKeys "{enter}", True
WaitTilDone:
a$ = Application.DDERequest(Channel, "Status")
'MsgBox a$
'For X = 1 To 10
'Next X
'If Left(a$, 5) <> "Ready" Then GoTo WaitTilDone
Application.DDEExecute Channel, "[set (" + Chr(34) + "window show" + Chr(34) + ")]"
Application.DDETerminate (Channel)
'Application.AppRestore
With Windows(CONhedoVorlage)
.WindowState = xlMinimized
.Visible = False
.Visible = True
.WindowState = xlMaximized 'lngOldState
.Activate
End With
With Workbooks(CONhedoVorlage).Worksheets("HEDO")
.Range("C5").Select
SendKeys "^v", True
.Range("D48").Value = Application.UserName
If .Pictures.Count = 1 Then
.Pictures(1).ShapeRange.Name = txtSucheID.text
With .Shapes(txtSucheID.text)
.PictureFormat.CropLeft = 11#
.PictureFormat.CropRight = 27#
.PictureFormat.CropTop = 22#
.PictureFormat.CropBottom = 9#
.Width = 500
.LockAspectRatio = msoTrue
End With
Else
Exit Sub
End If
.Protect 24519
.SaveAs CStr(strPathWahl & "\" & strDateiName & ".xls")
'Workbooks(strDateiName & ".xls").Close False
End With
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
Call CloseClipboard
End If
'ThisWorkbook.Activate
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "Unbekannter Fehler aufgetreten!" & vbCrLf & vbCrLf _
& "Laufzeitfehler Nr. " & Err.Number & vbCrLf & _
"Beschreibung: " & Err.Description & vbCrLf & vbCrLf & _
"Der Vorgang kann nicht ausgeführt werden.", vbCritical
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Snagit und Excel
Nike
Hi,
eine Holzfaellermethode waere wohl den IE zu maximieren,
nen Screenshot von allem zu machen und die Bilder im Nachgang
zurechtzuschneiden (crop)...
Bye
Nike
AW: Excel und Bilder
Stefan
Guten Tag
Genau diese Holzfällermethode habe ich bereits ausprobiert. Doch leider ist das ganze auch nicht das wahre. Arbeite ich auf dem Notbook ist meine zu kopierende A4-Seite am Ende. Da hilft auch auf Deskop-Höhe skalierte WebBrowsers nicht.
Ich frage mich, ob irgendwie mit API, Selection.PicturesCopy und Einfügen als Pictures was zu machen wäre. Im WebBrowser wäre eine CTRL + A (alles selektieren) und Ablage in der Zwischenspeicher ja möglich.
Grüsse
Stefan
Anzeige
Gute Idee oT
Sven
oT

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige