Przesuwanie punktów wykresu liniowego za pomocą myszy..
po mojemu ;-)
  strona główna:
A po co ten Excel ;-)
 
 
  blogs.office.com
..że niby była taka funkcjonalność w xl2003. :-) Spory kawałek czasu miałem tą wersję jednak nigdy tego nie widziałem.   Excel Add-In for Manipulating Points on Charts (MPOC)
Wygląda ciekawie: ustawiam się na dowolnym punkcie dowolnej serii wykresu liniowego i dany punkt zmienia swoje położenie  
w zależności od pozycji myszki.  
Od wersji xl2007 funkcjonalność ta jest możliwa do uzyskania
 
poprzez instalację dodatku (link z prawej). I zapewne działa  
znacznie lepiej niż to co pokażę dziś :-) Niemniej jednak  
kusiło mnie żeby spróbować własnych sił w tym temacie.  
W dzisiejszym przykładzie - przesuwanie pojedynczych  
punktów wykresu liniowego. Na "warsztacie" mam jeszcze  
przesuwanie całej serii oraz przesuwanie punktów wykresu XY  
ale będą to tematy na kiedy indziej :-)  
 
 
Procedura realizująca takie zadanie może wyglądać tak:  
 
Option Explicit  
    
Declare Sub CopyMemory _  
    Lib "kernel32" _  
    Alias "RtlMoveMemory" ( _  
        ByVal Destination As Long, _  
        ByVal Source As Long, _  
        ByVal Length As Long)  
      
Declare Function SetWindowsHookEx _  
    Lib "user32" _  
    Alias "SetWindowsHookExA" ( _  
        ByVal idHook As Long, _  
        ByVal lpfn As Long, _  
        ByVal hmod As Long, _  
        ByVal dwThreadId As Long) _  
    As Long  
      
Declare Function CallNextHookEx _  
    Lib "user32" ( _  
        ByVal hHook As Long, _  
        ByVal nCode As Long, _  
        ByVal wParam As Long, _  
        lParam As Any) _  
    As Long  
      
Declare Function UnhookWindowsHookEx _  
    Lib "user32" ( _  
        ByVal hHook As Long) _  
    As Long  
      
Declare Function GetActiveWindow _  
    Lib "user32" () As Long  
      
Declare Function FindWindow _  
    Lib "user32" _  
    Alias "FindWindowA" ( _  
        ByVal lpClassName As String, _  
        ByVal lpWindowName As String) _  
    As Long  
      
Declare Function GetCursorPos _  
    Lib "user32" ( _  
        lpPoint As POINTAPI) _  
    As Long  
      
Public Type POINTAPI  
    x As Long  
    y As Long  
End Type  
      
Type MSLLHOOKSTRUCT  
    pt As POINTAPI  
    mouseData As Long  
    flags As Long  
    time As Long  
    dwExtraInfo As Long  
End Type  
      
Const HC_ACTION = 0  
Const WH_MOUSE_LL = 14  
Const WM_MOUSEMOVE = &H200  
 
Dim pp As Single, pH As Single  
 
Dim hhkLowLevelMouse As Long  
Dim udtlParamStuct  As MSLLHOOKSTRUCT  
     
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT  
    CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)  
    GetHookStruct = udtlParamStuct  
End Function  
      
Function LowLevelMouseProc(ByVal nCode As Long, _  
                           ByVal wParam As Long, _  
                           ByVal lParam As Long) As Long  
    On Error Resume Next  
    Dim bMouseProc As Boolean, bEnd As Boolean  
    If GetActiveWindow = FindWindow("XLMAIN", Application.Caption) Then  
        If (nCode = HC_ACTION) Then  
          Select Case wParam  
              Case WM_MOUSEMOVE  
                
              MMove lParam, bMouseProc, bEnd  
              LowLevelMouseProc = bMouseProc  
              If bEnd Then Exit Function  
          End Select  
        End If  
    End If  
      
    With Arkusz1.ChartObjects(1).Chart  
        pp = (.Axes(xlValue).MaximumScale - _  
              .Axes(xlValue).MinimumScale) / .Parent.Height  
        pH = .Parent.Height * 1.15  
    End With  
      
    LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)  
End Function  
      
Sub Hook_Mouse()  
    hhkLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, _  
                                         AddressOf LowLevelMouseProc, _  
                                         Application.Hinstance, 0)  
End Sub  
      
Sub UnHook_Mouse()  
    If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse  
End Sub  
      
Sub MMove(HookStructLParam As Long, _  
          ByRef czyZdarzenieNastapilo As Boolean, _  
          ByRef bFlag As Boolean)  
      
    Dim objShp As Object  
    Dim point As POINTAPI: GetCursorPos point  
    Dim rng As Excel.Range, xlSer As Excel.Series  
          
    On Error Resume Next  
    Set objShp = ActiveWindow.RangeFromPoint(x:=point.x, _  
                                             y:=point.y)  
    On Error GoTo 0  
 
    If TypeName(objShp) = "ChartObject" Then  
        If TypeName(Selection) = "Point" Then  
            '[F1] = Split(Selection.Name, "P")(1) * 1 - 1  
            '[G1] = Application.Range(Split(Selection.Parent.Formula, ",")(2)).Address  
            Application.Range(Split(Selection.Parent.Formula, ",")(2)).Cells(Split(Selection.Name, "P")(1) * 1) = (pH - point.y) * pp  
        End If  
    End If  
 
    czyZdarzenieNastapilo = False: bFlag = True  
    Set objShp = Nothing  
End Sub  
 
Opisowo :-)  
Procedury Hook'a nie tłumaczę bo jej nie rozumiem ;-P po prostu… przepisuję ją i modyfikuję na własne potrzeby.  
 
Const WM_MOUSEMOVE = &H200  
 
Wykorzystam WM_MOUSEMOVE message żeby wykorzystać ruch myszy nad wykresem.   WM_MOUSEMOVE message
Próbowałem wykorzystać WM_LBUTTONUP i WM_LBUTTONDOWN ale procedura po kliknięciu punktu zawieszała swoje zadanie do    WM_LBUTTONDOWN message
momentu puszczenia przycisku. Punkt reagował prawidłowo ale nie było płynności w przesunięciu. Porzuciłem ten pomysł na korzyść   WM_LBUTTONUP message
WM_MOUSEMOVE. Konsekwencją jest następująca: Klikamy na dany punkt i kiedy jest zaznaczony przesuwamy musza w górę/dół  
bez klikania/przytrzymania klawisza.   
 
Dim pp As Single, pH As Single  
    With Arkusz1.ChartObjects(1).Chart  
        pp = (.Axes(xlValue).MaximumScale - _  
              .Axes(xlValue).MinimumScale) / .Parent.Height  
        pH = .Parent.Height * 1.15  
    End With  
 
Zmienne te określają jednostkę przesunięcia, którą wyliczam różnicą pomiędzy min i max skali wykresu / przez jego wysokość.  
Zmienne te wykorzystam określając nową pozycję poruszanego punktu w zależności od położenia myszki nad wykresem.  
 
Sub Mmove …  
 
    Set objShp = ActiveWindow.RangeFromPoint(x:=point.x, _  
                                             y:=point.y)
 
tworzy zmienną obiektową będącą obiektem nad którym znajduje się kursor myszy.  
 
    If TypeName(objShp) = "ChartObject" Then  
        If TypeName(Selection) = "Point" Then  
 
Jeżeli obiektem tym jest wykres i zaznaczony jest punkt..  
 
Następnie z klikniętego punktu należy określić jego serię: a więc..  
Selection.Parent  
 
Z formuły tej serii (obrazy obok) trzeba wyciągnąć zakres będący źródłem serii..  
Split(Selection.Parent.Formula, ",")(2)
 
 
Z nazwy punktu można wyciągnąć informację którym ten punkt jest serii:  
Cells(Split(Selection.Name, "P")(1) * 1)  
 
łącząc te informacje wiemy którą komórkę należy zmieniać żeby odpowiedni punkt wykresu został poruszony.  
Application.Range(Split(Selection.Parent.Formula, ",")(2)).Cells(Split(Selection.Name, "P")(1) * 1)  
 
na jaką wartość zmienić ten punkt?? Na…   przykład do pobrania 
(pH - point.y) * pp   xlchr05.zip
różnica między wysokością wykresu a pozycją "y" myszy * jednostkę przesunięcia. :-)  
 
tyle :-)