Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

IF Then Mausabfrage

nach unten

Betrifft: IF Then Mausabfrage von: Aton
Geschrieben am: 30.09.2020 20:50:37

Hallo


Ich würde mich freuen, wenn jemand meine Mausabfrage zum fuktionieren brächte.


Gruß Aton


Dim UdtPoints As POINTAPI

Dim LaufZeit As Long

Dim X As Long, Y As Long

Option Explicit

Private Declare 



Function GetCursorPos Lib "user32" ( _
   lpPoint As POINTAPI) As Long
   Private Type POINTAPI
   X As Long
   Y As Long
End Type



Sub CursorPosition_Statusleiste()
   For LaufZeit = 1 To 400
      GetCursorPos UdtPoints
      ' Application.StatusBar = "Xpos " & CStr(UdtPoints.x) & " XPos " & CStr(UdtPoints.y) ' X   _
 _
Pos und Y Pos in der Statusleiste anzeigen
      Range("B1") = CStr(UdtPoints.X) ' X Pos
      Range("C1") = CStr(UdtPoints.Y) ' Y Pos
      
     ' If "Maustaste Links gedrückt" Then Application.Run "LinienZeichnen", X, Y ' Mein Makro   _
_
das die Linie zeichnet
     ' If "Maustaste Rechts gedrückt" Then Exit For ' Zeitschleife verlassen
      
   Next LaufZeit
   Application.Run "LinienZeichnen", X, Y ' Der Aufruf der mein Makro startet, das die Linie  _
zeichnet.
   ' 1. Makrostart wird Start Punkt gesetzt.
   ' 2. Makrostart wir die Line vom Startpunkt zu diesem Punkt gezeichnet.
   ' 3. Und dann als neuer Startpunkt  gemerkt.
   ' 4. So kann ich eine Linienfolge von Punkt 1 zu 2 zu 3 usw. zeichnen. Punkt = Pixel auf  _
Bildschirm.
   ' 5. Muss aber für jeden Punkt das Makro neu starten.
   ' 6. Mit einer Maustastenabfrage müsste ich nicht immer 2 Sekunden warten um einen Punkt  _
festzulegen
   '     und könnte eine Dauerschleife mit der Rechten Maustaste verlassen, wenn ich den   _
letzten Punkt eingegeben habe.
End Sub







nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Daniel

Geschrieben am: 30.09.2020 21:25:47


Hi

dann solltest du die Datei hochladen und kurz beschreiben, was das Makro macht, wie man die Datei bedienen soll und wo genau der Fehler liegt, dh was sollte der Code machen und was macht er tatsächlich?

Gruß Daniel





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 30.09.2020 22:11:06


Hallo



Beim Makrostart wird in der Zeitschleife

von 2 Sekunden diese Koordinaten permanent angezeigt.



In B1 wird die X Koordinate angezeigt.

In C1 wird die Y Koordinate angezeigt.



Wenn die Zeitschleife nach 2 Sekunden endet.

Stehen in B1 und C1 die letzten Werte des Bildpunktes wo die Maus hinzeigte.

Diese Werte benutze ich dann zum Zeichnen.



Diese 2 Abfragen sollen funktionieren in der Zeitschleife von 1 to 400



Die Zeitschleife durch Mausschleife ersetzen, in der ich Linke Maustaste Drücken und abfragen kann, und Rechte Maustaste diese verlässt.

Mausschleife

In B1 wird die X Koordinate angezeigt.

In C1 wird die Y Koordinate angezeigt.

If "Maustaste Links gedrückt" Then Linie zeichnen

If "Maustaste Rechts gedrückt" Then exit for = Zeitschleife verlassen

Mausschleife Ende



Ich weis nicht wie eine Mausschleife gemacht wird.

In der die Maus sichtbar ist, und ich über IF Then die Maustasten abfragen kann.



So muss ich immer 2cSekunden warten bis ich die Werte in B1 und C1 benutzen kann.





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 30.09.2020 22:29:45


Hallo



Anders formuliert.



Mausschleife



Linke Maustaste soll das tun: Cells(1,1)= Cells(1,1) + 1

Rechte Maustaste soll das tun: Cells(1,1)= Cells(1,1) - 1

Linke und Rechte Maustaste soll die Schleife verlassen.



In der Schleife in A1 X-Koordinate des Bildpunktes

In der Schleife in B1 Y-Koordinate des Bildpunktes

Die Maus muss sichtbar und bewegbar in der Schleife sein.






nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: volti

Geschrieben am: 30.09.2020 22:49:32


Hallo Aton,



hier mal eine Idee wie in einer Schleife Mausposition und die Tastenzustände abgefragt werden können.

Vielleicht bringt Dich das ja weiter...




Code:


[Cc][+][-]
 
Option Explicit

Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const VK_RBUTTON = &H2
Const VK_LBUTTON = &H1

Type POINTAPI
  x As Long
  y As Long
End Type

Sub Mausabfrage()
 Dim Pos As POINTAPI
 
 Do
  DoEvents
  If GetAsyncKeyState(VK_RBUTTON) > 0 Then Exit Do
  GetCursorPos Pos
  Range("B1").Value = Pos.x
  Range("C1").Value = Pos.y
  If GetAsyncKeyState(VK_LBUTTON) > 0 Then
'Linie Zeichnen
    Beep
  End If
  Sleep 100
 Loop
 
End Sub
 
____________________
viele Grüße aus Freigericht
Karl-Heinz






nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 30.09.2020 23:03:22


Hallo



Das ist genau das was ich brauchte



Was verzögert sleep  ?



Kann man auch beide Maustasten gleichzeitig zum abbruch abfragen ?



Vielen Dank für die Antwort



Gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: volti

Geschrieben am: 30.09.2020 23:49:13


Hallo Aton,



Sleep verzögert die Ausführung um x Millisekunden also hier um 100 msec.



Über VK_RBUTTON und VK_LBUTTON wird abgefragt, ob die linke oder rechte Maustaste gedrückt ist.



Beide Tasten zusammen abfragen ist leider m.E. mit dieser Methode nicht möglich.

Möglicherweise könntest Du den Mittelbutton verwenden.



viele Grüße

Karl-Heinz





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 01.10.2020 00:23:33


Hallo



Am anfang hat es in einer leeren mappe funktioniert.



man hat das beep gehört.



Aber nachdem ich es in meine makros copiert habe jetzt geht es nicht mehr.

weder der beep noch der Abbruch mit rechter maustaste.



Muß es mit esc unterbrechen.



eigentlich wollte ich nur eine Liniefolge damit zeichnen. 



ich denke es liegt an  



Option Explicit   ,   aber nur vermutung von mir.



Muß es morgen noch mal probieren.



Gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 01.10.2020 01:12:10


Hallo



Warum geht das nicht so



Zum Test bei L oder R Klick soll wert in Celle 1,8 oder 1,7 geschrieben werden.

von Celle 1,3 oder 1,2.



die Cellen werden makiert, aber die IFs - Then der Mausabfrage funktionieren nicht , leider

 

Option Explicit



Declare PtrSafe 
Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare PtrSafe 
Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare PtrSafe 
Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const VK_RBUTTON = &H2
Const VK_LBUTTON = &H1

Type POINTAPI
  x As Long
  y As Long
End Type


Sub Mausabfrage()
 Dim Pos As POINTAPI
 
 Do
  DoEvents
  If GetAsyncKeyState(VK_RBUTTON) > 0 Then Cells(1, 8) = Cells(1, 3)
  GetCursorPos Pos
  Range("B1").Value = Pos.x
  Range("C1").Value = Pos.y
  If GetAsyncKeyState(VK_LBUTTON) > 0 Then Cells(1, 7) = Cells(1, 2)
  Sleep 100
 Loop
 
End Sub






nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: fcs

Geschrieben am: 01.10.2020 07:42:15


Hallo Anton,



warum die Klimmzüge zum Zeichnen eines Linienzuges per Makro?



Unter den Formen in Excel gibt es 2 mit denen du Linienzüge zeichnen kannst.



Kurve

bei gedrückter Strg-Taste wird hier mit Linke-Maus-Taste-Klicks ein Linienzug aus geraden Linien erzeugt. Mit Doppel-Klick wird der letzte Punkt gesetzt oder man bricht mit ESC ab.





Freihandform: Form

Mit Linke-Maus-Taste-Klicks der Linienzug erzeugt. Mit Doppel-Klick wird der letzte Punkt gesetzt oder man bricht mit ESC ab.

Hier kann man per Klick auf den Startpunkt den Linienzug auch zu einer Fläche schließen.



LG

Franz





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 01.10.2020 18:56:40


Hallo



Nicht das Zeichnen ist das Problem.



Ich brauche eine Mauschleife in der ich so oft ich will

die linke Maustaste drücken kann und ein Makro aufrufen kann.

Die rechte Maustaste am besten genauso, abrechen kann ich auch

mit ESC . 

in der Mausschleife soll aber X-Y Koordinaten in B1 und C1 laufend

angezeigt werden. mm besten noch ein Kreuz als Mauszeiger.

Das Makro das ich habe, funktioniert die IF Thens nicht.

Das ist das Problem eine zuverläßige Maustasten Abfrage.





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Daniel

Geschrieben am: 01.10.2020 19:27:47


Hi

mal so ne andere Idee:

lege auf das Blatt einen unauffälligen Commandbutton.

zum Beginn des Zeichens vergrößerst du diesen Button auf die Größe des Excelfensters oder sogar auf Größe des benötigten Bereichs und schaltest den Button-Hintergrund auf Transparent, damit du das darunter liegende Excelblatt siehst.



da jetzt alle Mausaktivitäten auf den Button wirken, kannst du Klick-Position und verwendeten Button problemslos im MouseDown oder im MouseUp-Event abfragen.

Damit läuft dann alles mit in der Hilfe dokumentierten Standard-VBA-Funktionen und du brauchst kein spezielles Windows-Fachwissen (API).



beim Beenden verkleinerst du den Button dann wieder.



Gruß Daniel





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 01.10.2020 19:55:11


Hallo



Die Idee ist gut, aber die Bild Qualität ist dabei viel schlechter und somit ansträngender damit zu arbeiten, werde mich mal damit beschäftigen.

Stichwort Windows:

Mann kann doch den Arbeitspeicher mit Makros auslesen. Windos müßte doch eigentlich Adressen für die Maustasten haben, vieleicht ist da der zugriff möglich.



Gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: Aton

Geschrieben am: 03.10.2020 10:54:37


Hallo



Hat jemand eine Ahnung wie man mit vba die Mausadresen bei windows auslesen kann, in ein makro.



gruß aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage





von: volti

Geschrieben am: 03.10.2020 12:14:10


Hallo Aton,



da das Thema wohl noch offen ist und sonst niemand antwortet, hier noch ein Versuch:



Wenn es noch so ist wie früher, laufen die Mausaktivitäten über einen Port ein und werden vom Maustreiber entsprechend verarbeitet.

Über Mausadressen im Arbeitsspeicher weiß ich nichts. Ich lasse die Frage deshalb mal offen.



Die von mir anfangs vorgeschlagene Abfrage der Maustasten mittels GetAsyncKeyState funktioniert schon, allerdings werden weiterhin die Mausaktivitäten an Excel gesendet, so dass das dann etwas unsauber funktioniert.



Z.B. müsstest Du auch die Rechtsclick-Routine bei den Tabellenevents abschalten, da die ja Dein Vorhaben zunichte machen.



Hier mal eine neue Idee, die allerdings etwas umfangreicher ist und die Mausaktivitäten in einer eigenen Prozedur abfängt.

Vielleicht sagt sie Dir ja mehr zu. Probiere es einfach mal aus.



Diesen Code hier ein das Tabellenmodul:
Code:


[Cc]
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Mausabfrage
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 If gbMausaktion Then Cancel = True
End Sub
 



Diesen Code hier ein normales Modul:


Code:


[Cc][+][-]
 
Option Explicit

Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" ( _
        ByVal idHook As Long, ByVal lpfn As LongPtr, _
        ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
        ByVal hHook As LongPtr, ByVal ncode As Long, _
        ByVal wParam As LongPtr, lParam As Any) As LongPtr
Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
        ByVal hHook As LongPtr) As Long
Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function GetAsyncKeyState Lib "user32" ( _
        ByVal vKey As Long) As Integer

Type POINTAPI
  x As Long
  y As Long
End Type

Type MOUSEHOOKSTRUCT
  PT           As POINTAPI
  hWnd         As LongPtr
  wHitTestCode As Long
  dwExtraInfo  As LongPtr
End Type

Public gbMausaktion As Boolean
Const WM_LBUTTONDOWN = &H201
Const WM_RBUTTONDOWN = &H204
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONUP = &H205

Const HC_ACTION = &H0
Const WH_MOUSE = 7
Const GWL_HINSTANCE = (-6)

Dim hHook As LongPtr

Sub Mausabfrage()
 
 gbMausaktion = True
 hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, _
         GetWindowLongPtr(Application.hWnd, GWL_HINSTANCE), _
         GetCurrentThreadId)
 
 Do
  DoEvents
  If GetAsyncKeyState(27) <> 0 Then Exit Do 'Exit
 Loop
 
 gbMausaktion = False
 UnhookWindowsHookEx hHook                  'UnHook ist wichtig
 MsgBox "Aktion beendet!", vbInformation, "Maus..."
End Sub


Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, _
        lParam As MOUSEHOOKSTRUCT) As LongPtr
 On Error GoTo Fehler
 
 Select Case ncode
 Case HC_ACTION
    If lParam.hWnd > 0 Then
       Range("B1").Value = lParam.PT.x  'Mausposition X in Zelle ablegen
       Range("C1").Value = lParam.PT.y  'Mausposition Y in Zelle ablegen
          
       Select Case wParam
       Case WM_LBUTTONDOWN: Cells(1, 7) = Cells(1, 2)
       Case WM_RBUTTONDOWN: Cells(1, 8) = Cells(1, 3)
       Case WM_LBUTTONUP, WM_RBUTTONUP
       End Select
       
    End If
 Case Else
    MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam)
 End Select

Fehler:
End Function
 
____________________
viele Grüße aus Freigericht
Karl-Heinz






nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 03.10.2020 15:16:57


Hallo



Ich speichere alle Makros die ich habe in Modul1.



Geladen wird immer Personal.xlb mit Makros die ich immer

zur verfügung haben will. Speicherungssicherungen Zeile einfügen, usw.



Für das Zeichnen gibt es Zeichenendateien ohne Makros das sind die verschidenen Verteiler.



Die Makros dazu sind in folgenden Mudul1 Dateien gespeichert.



MS Ansichten, für die Außenansichten der Verteiler zu zeichnen.

MS VT Plan zeichnen, für die Schaltpläne zu zeichnen.



In den einzelnen Zeichnen Dateien sind keine Makros nur Textfelder die das 

jeweilige Zeichenen Makro aufrufen. ( Sicherung, Leitungsverbindung, Anschluß ) usw.



Ist der Verteiler fertig, kann ich diese Textfelder Löschen zum Speichern der Dateien.

Wenn ich was ändern will kann ich die Textfelder über Makro wieder einfügen.



Makros bei mir immer in Modul1 gespeichert.



Was meinst du mit Normalen Modul und Tabellen Modul.



Ich kenne nur Userform1, Modul1, Klasse1. Wobei ich bis jetzt nur Modul1 nutze.



Peronal.Xlb für immer ausführbare Makros,

oder -MS Name- für spetzele Aufgabenmakros. ( Ansicht, Zeichnen, Kalender ) usw.

die eigentlichen Dateien sind Makrofrei.













 





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 03.10.2020 16:24:10


Hallo

Habe es getestet. Super enau das was ich gesucht habe.



Habe Tabellen Mudul1 in Modul1 gesichert.

Normale Modul in Modul2 gesichert

in der Arbeitsmappe MS Mausabfrage.



Danach getestet. Mausabfrage Links Funktioniert super.

Mausabfrage Rechtss Funktioniert super.

Abbruch über ESC auch super.



Kann ich auch Rechte Maustaste zum Abbruch nehmen ?



Was meintest du mit Tabellenmodul ?



Vielen Dank für diese Antwort, ist genau das was ich wollte.





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: volti

Geschrieben am: 03.10.2020 17:36:57


Hallo  Aton,



vielen Dank für die positive Rückmeldung.



Mit "Tabellenmodul" meinte ich das Klassenmodul der Tabelle, in dem die Felder gefüllt werden.

Dort hatte ich mit dem ersten Codeteil den Rechtsklick abgeschaltet und den Start der Sub über Doppelklick auf dem Tabellenblatt generiert.



Vielleicht brauchst Du das ja auch nicht, ich kenne (mangels bereitgestellter Datei) ja nicht Deine genaue Vorgehensweise und Anforderung...



Kann ich auch Rechte Maustaste zum Abbruch nehmen ?

Ja, na klar z.B. so:




Code:


[Cc][+][-]
 
Option Explicit

Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
        Alias "SetWindowsHookExA" ( _
        ByVal idHook As Long, ByVal lpfn As LongPtr, _
        ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
        ByVal hHook As LongPtr, ByVal ncode As Long, _
        ByVal wParam As LongPtr, lParam As Any) As LongPtr
Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
        ByVal hHook As LongPtr) As Long
Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function GetAsyncKeyState Lib "user32" ( _
        ByVal vKey As Long) As Integer

Type POINTAPI
  x As Long
  y As Long
End Type

Type MOUSEHOOKSTRUCT
  PT           As POINTAPI
  hWnd         As LongPtr
  wHitTestCode As Long
  dwExtraInfo  As LongPtr
End Type

Public gbMausaktion As Boolean
Const WM_LBUTTONDOWN = &H201
Const WM_RBUTTONDOWN = &H204
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONUP = &H205

Const HC_ACTION = &H0
Const WH_MOUSE = 7
Const GWL_HINSTANCE = (-6)

Dim hHook As LongPtr
Dim gbAbbruch As Boolean

Sub Mausabfrage()
 
 gbMausaktion = True
 hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, _
         GetWindowLongPtr(Application.hWnd, GWL_HINSTANCE), _
         GetCurrentThreadId)
 
 Do
  DoEvents
  If gbAbbruch = True Then Exit Do
  If GetAsyncKeyState(27) <> 0 Then Exit Do 'Exit
 Loop
 
 gbMausaktion = False
 UnhookWindowsHookEx hHook                  'UnHook ist wichtig
 MsgBox "Aktion beendet!", vbInformation, "Maus..."
End Sub


Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, _
        lParam As MOUSEHOOKSTRUCT) As LongPtr
 On Error GoTo Fehler
 
 Select Case ncode
 Case HC_ACTION
    If lParam.hWnd > 0 Then
       Range("B1").Value = lParam.PT.x  'Mausposition X in Zelle ablegen
       Range("C1").Value = lParam.PT.y  'Mausposition Y in Zelle ablegen
          
       Select Case wParam
       Case WM_LBUTTONDOWN: Cells(1, 7) = Cells(1, 2)
       Case WM_RBUTTONDOWN: Cells(1, 8) = Cells(1, 3)
                            gbAbbruch = True
       Case WM_LBUTTONUP, WM_RBUTTONUP
       End Select
       
    End If
 Case Else
    MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam)
 End Select

Fehler:
End Function
 
____________________
viele Grüße aus Freigericht
Karl-Heinz








viele Grüße

Karl-Heinz





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 03.10.2020 18:37:30


Hallo



Lade mal meine Testdatei hoch. Es Funktionierte am Anfang sehr gut.

Den linken Rand konnte ich einstellen mit X-25 und Y-113.

Ich vermute das ich eine Formel benutzen muss um die Punkte zu berechnen.

Der rechte untere Rand wird ca. 1/3 zu weit gezeichnet.

Nehme an daß das Excel-Fenster zum Gesammtbild des Bildschirms berechnen muss.



Will nur im Fenster mit A1 in der Linken Oberen Ecke zeichnen. ( Pixel gleich wenn möglich )



Aber auf ein mal funktioniert es nicht mehr.



Die Datei wird nach einem Beep geschlossen, nachdem ich das Makro starte.



Ich hoffe du kannst das Makro so ändern.



Gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 03.10.2020 18:45:37


Hallo



Das hochladen hatte nicht funktioniert,

gruß Aton



https://www.herber.de/bbs/user/140623.xlsm






nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: volti

Geschrieben am: 04.10.2020 00:59:07


Hallo Aton,



Deine Ausführungen und Dein Code mit den Berechnungen sind mir leider nicht ganz klar.



Wenn Du aber pixelgenau zeichnen möchtest, habe ich in anliegender Datei versucht, das zu realisieren.

Hierzu sind aber diverse Umrechnungen nötig.



Du startest einfach mit Doppelclick Deine Zeichnung und beendest sie mit Rechtsclck.



Zeichnen.xlsm



viele Grüße

Karl-Heinz





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 04.10.2020 05:37:54


Hallo



Das ist genial, bedanke mich herzlich.



Umrechnugsfaktor ist 1,334



Gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: volti

Geschrieben am: 04.10.2020 09:29:06


Hallo,



ich glaube, der Start nach dem DP war noch nicht so günstig und außerdem sollte doch zur Orientierung eine Positionsanzeige z.B. in der Statusbar sein.

Umrechnungsfaktor hängt vom Bildschirm ab.



Zeichnen.xlsm



viele Grüße

Karl-Heinz





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 04.10.2020 13:19:05


Hallo



Es ist genau was ich wollte, sogar viel besser. Man kann nach unten und rechts zeichnen soweit man will.



Damit kann ich sogar bei der Drucker-Ansicht noch kleine Änderungen vornehmen.



Musste das Löschen abschalten, da damit alle schon vorhandenen Zeichnungen und Textfelder gelöscht werden. 



Wenn löschen dann nur die damit gerade gezeichneten Linienfolge. Wenn die Linienfolge ein Fehler hatte. außer es wurde gespeichert, denn dann gehört es zum Plan und soll natürlich bleiben.



Was vielleicht noch haben möchte wäre ein Zielkreuz 11 x 11 Pixel als Mauszeiger. Da wäre das positionieren der Maus viel leichter auf den vorhanden Linien und anderen Formen.



Super wäre wenn Start und Endpunkt, bei der X oder Y Koordinate weniger als 5 Punkte Unterschied hat auf der Koordinate vom Startpunkt gezeichnet wird. Dann muss ich beim setzen des Endpunktes nicht so genau zielen.



zB. S-Punkt = 751,681 E-Punkt 367,683 gezeichnet dann SP 751,681 zu 367,681 Waagrecht



zB. S-Punkt = 13,45 E-Punkt 17,201 gezeichnet dann SP 13,45 zu 13,201 Senkrecht



Berichtigung der Linien, nach oben, rechts, unten und links der Linien.







Bedanke mich herzlich gruß Aton





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: volti

Geschrieben am: 04.10.2020 19:39:53


Hallo,



ich habe noch ein wenig rumprobiert.



Die Autopositonskorrektur zum Zeichnen von waagerechten und senkrechten Linien ist eingebaut und auch etwas Sicherheit, falls mal außerhalb der Zeichenfläche geklickt wird.



Cursorform:

Über die Windows-API kann die Mauscurosorform mit beliebigen internen Cursorformen oder selbst geladenen Cursor aus z.B. .CUR-Dateien verändert werden.

Stichwort: SetCursor (LoadCursor(0, IDC_CROSS))

Leider blitzt das nur kurzzeitig auf und dann hat Excel auch schon wieder seine eigenen sehr beschränkten Cursorformen übernommen.

Deshalb hatte ich Dir ja die Zeigerform da eingestellt und da wirst Du wohl auch mit arbeiten müssen.



Einen entsprechend der jeweiligen Cursorposition mitlaufenden Linienendpunkt bis zum Festsetzungsklick hatte ich auch mal probiert. Leider ist das Linienobjekt hier sehr bockig wenn sich die Richtung ändert (statt nach links nach rechts usw.).

Ich habe das dann aus Aufwandsgründen wieder aufgegeben.



Wenn man das Blatt schützt, läuft auch nicht immer die Zellmarkierung mit, die nervt sonst schon ganz schön.



Probiere es halt mal aus...



Zeichnen.xslm



VG KH





nach oben  nach unten

Betrifft: AW: IF Then Mausabfrage volti





von: Aton

Geschrieben am: 04.10.2020 22:34:13


Hallo



Das ist perfekt.



Herzlichen Dank für deinen Aufwand.



Gruß Aton