อยากใช้vba กำหนดค่าxและy ในscatter chartครับ

[tuidento]

คือถ้าเรามีscatter chart อยู่ แล้วอยากเอา mouse ไปclick ที่ตำแหน่งในกราฟ แล้วให้ค่าแกนxและแกนyของจุดนั้น ไปใส่ในcell ที่เรากำหนดได้ไหมครับ
พยายามหาวิธีเขียนมานานแล้วแต่หาไม่ได้เลยครับ
ขอบคุณมากครับ

[snasui]

ลองแนบไฟล์พร้อม Code ที่ลองเขียนเองแล้วมาดูกันครับ

[tuidento]

คือไม่รู้จะเริ่มยังไงเลยครับ
แค่ต้องการกำหนดจุดเองโดยใช้mouse เพราะการลากจุดในchart (excel2003) มันช้ามากถ้ามีหลายๆจุดครับ เพราะจะเอาค่าแต่ละจุดไปคำนวนต่อครับ

[snasui]

หากเป็นเช่นนั้นคงช่วยไม่ได้มาก เนื่องจากว่าการใช้ VBA จำเป็นต้องเขียนมาก่อนตามกฎการใช้บอร์ดด้านบนครับ

[tuidento]

ผมลองใช้ codeนี้แล้วมันกำหนด เป็นค่าแกน X, Y ของmouseนะครับ ไม่ใช้ของchart
มีวิธีให้เป็นค่าของchart ไหมครับ
ขอบคุณครับ

Private Sub Chart_MouseDown(ByVal Button As Long, _
ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

MsgBox "X = " & X & " Y = " & Y
ActiveWorkbook.Worksheets("Sheet2").Range("c1").Value = X
ActiveWorkbook.Worksheets("Sheet2").Range("c2").Value = Y
End Sub

[snasui]

ควรแนบไฟล์ตัวอย่างมาด้วย Code ที่เขียนจำเป็นต้องมุ่งหมายที่จะใช้กับ Chart ครับ ติดตรงไหนจะได้ช่วยกันปรับปรุงแก้ไขต่อไปจากนั้น

[tuidento]

fileครับ

[snasui]

ลองตามนี้ครับ

1. วาดวงกลมเล็ก ๆ ลงใน Chart เดิม
2. คลิกที่วงกลมแล้วไปที่ NameBox คีย์ข้อความเป็น ovlPointer
3. เพิ่ม Module ปกติแล้วนำ Code ด้านล่างไปวาง

   Code: Select all

   Private Declare Function GetDC Lib "user32" _
           (ByVal hwnd As Long) As Long
   
   Private Declare Function GetDeviceCaps Lib "gdi32" _
           (ByVal hDC As Long, ByVal nIndex As Long) As Long
   
   Private Declare Function ReleaseDC Lib "user32" _
           (ByVal hwnd As Long, ByVal hDC As Long) As Long
   
   Private Const LOGPIXELSX = 88    'Pixels/inch in X
   
   'A point is defined as 1/72 inches
   Private Const POINTS_PER_INCH As Long = 72
   
   'The size of a pixel, in points
   Public Function PointsPerPixel() As Double
   
     Dim hDC As Long
     Dim lDotsPerInch As Long
   
     hDC = GetDC(0)
     lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
     PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
     ReleaseDC 0, hDC
   
   End Function

4. นำ Code ด้านล่างไปวางใน Chart Sheet แทน Code เดิม

   Code: Select all

   Private Sub Chart_MouseMove(ByVal Button As Long, _
           ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
       Dim dZoom As Double
       Dim dXVal As Double
       Dim dYVal As Double
       Dim dPixelSize As Double
       
       On Error Resume Next
       Set mchtChart = Charts(1)
       'The active window zoom factor
       dZoom = ActiveWindow.Zoom / 100
       
       'The pixel size, in points
       dPixelSize = PointsPerPixel
       
       'Mouse coordinates to (XY) Data coordinates
       With mchtChart
         dXVal = .Axes(xlCategory).MinimumScale + _
           (.Axes(xlCategory).MaximumScale - _
            .Axes(xlCategory).MinimumScale) * _
           (X * dPixelSize / dZoom - _
            (.PlotArea.InsideLeft + .ChartArea.Left)) / _
           .PlotArea.InsideWidth
       
         dYVal = .Axes(xlValue).MinimumScale + _
           (.Axes(xlValue).MaximumScale - _
            .Axes(xlValue).MinimumScale) * _
           (1 - (Y * dPixelSize / dZoom - _
                 (.PlotArea.InsideTop + .ChartArea.Top)) / _
           .PlotArea.InsideHeight)
       End With
       
       Application.StatusBar = "(" & Application.Round(dXVal, 2) _
           & ", " & Application.Round(dYVal, 2) & ")"
       
       'Mouse coordinates to Drawing Object Points
       
       'We'll only move the oval if the Shift key is pressed
       If Shift = 1 Then
         With mchtChart
           dXVal = (X * dPixelSize / dZoom - .ChartArea.Left)
           dYVal = (Y * dPixelSize / dZoom - .ChartArea.Top)
       
           With .Shapes("ovlPointer")
             .Left = dXVal - .Width / 2
             .Top = dYVal - .Height / 2
           End With
         End With
       End If
   
   End Sub

5. เมื่อเลื่อนเมาส์ สังเกตที่ Status bar ลองกดแป้น Shift ร่วมด้วยแล้วสังเกตวงกลมที่วาดไว้
6. ปรับ Code เพื่อนำไปใช้กับเซลล์ตามต้องการ

!	Note: ปรับปรุง Code เล็กน้อย จาก "Professional Excel development" Chapter 15 By Stephen Bullen, Rob Bovey, John Green

[tuidento]

ขอบคุณมากครับ จะลองไปทำดูครับ

[tuidento]

ลองทำดูแล้วครับ วงกลมไม่ขยับเลย แต่เห็นค่าแกนx,yแปลงเปลี่ยนที่status barครับ แต่ค่าไม่ตรงกับแกนครับ
และถ้าอยาก ให้กดครั้งที่1 ค่าx บันทึกที่ ("sheet1").range("d1") ค่าyบันทึกที่("sheet1").range("E1")
และกดครั้งที่2 ค่าx บันทึกที่ ("sheet1").range("d2") ค่าyบันทึกที่("sheet1").range("E2")
ประมาณนี้ได้ไหมครับ

[snasui]

ลองทำดูแล้วครับ วงกลมไม่ขยับเลย แต่เห็นค่าแกนx,yแปลงเปลี่ยนที่status barครับ แต่ค่าไม่ตรงกับแกนครับ

ที่ไม่ตรงแกนเพราะไม่ได้ดูที่เมาส์ แต่เป้าหมายคือให้ดูที่วงกลมที่วาดขึ้น ลองทดสอบใหม่ตามไฟล์ที่ผมแนบมา ซึ่งผมได้เปลี่ยนให้ดูที่ Shapes(2) แทนShapes("ovalPointer") ซึ่งจริง ๆ แล้วต้องไม่ต่างกัน

และถ้าอยาก ให้กดครั้งที่1 ค่าx บันทึกที่ ("sheet1").range("d1") ค่าyบันทึกที่("sheet1").range("E1")
และกดครั้งที่2 ค่าx บันทึกที่ ("sheet1").range("d2") ค่าyบันทึกที่("sheet1").range("E2")
ประมาณนี้ได้ไหมครับ

การทำเช่นนั้นผมคิดว่าไม่น่าจะมีปัญหาใด เพียงแต่เปลี่ยนจาก MouseMove เป็น MouseDown และปรับการแสดงผลที่ Status bar เป็นแสดงที่เซลล์เป้าหมายแทน ซึ่งควรเขียนมาเอง ติดตรงไหนแล้วค่อยถามกันครับ

[tuidento]

ลองดูแล้วครับ ทำไมจุดแดงมันไม่เคลื่อนมาที mouse clickล่ะครับ และค่าx,y มันผิดนะครับ
และจะบันทึกในการคลิ้กครั้งต่อไป มันทำยังไงครับ ผมลองcopy อีกรอบแต่ไม่ได้ครับ
ขอบคุณครับ และขอโทษที่ถามเยอะครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่าง

ให้กด Shift ร่วมด้วยเพื่อเห็นว่าจุดแดงเลื่อนไปตำแหน่งใด ดู Status bar เพื่อเห็นว่าค่า x,y เป็นเท่าใด เมื่อได้ค่าที่ต้องการแล้วค่อยคลิก ค่าในกราฟคือค่าตามตำแหน่งจุดแดง การที่ตำแหน่งจุดแดงไม่ตรงกับเมาส์เพราะมีการแปลงตำแหน่ง Point ให้เป็น Pixel บนหน้าจอ

Code: Select all

Dim dXVal As Double
Dim dYVal As Double
Dim dXVal1 As Double
Dim dYVal1 As Double
Dim dZoom As Double
Dim dPixelSize As Double
Dim mchtChart As Chart

Private Sub Chart_MouseMove(ByVal Button As Long, _
        ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Set mchtChart = Charts(1)
    On Error Resume Next
    'The active window zoom factor
    dZoom = ActiveWindow.Zoom / 100
    'The pixel size, in points
    dPixelSize = PointsPerPixel
    'Mouse coordinates to (XY) Data coordinates
    With mchtChart
        dXVal = .Axes(xlCategory).MinimumScale + _
            (.Axes(xlCategory).MaximumScale - _
            .Axes(xlCategory).MinimumScale) * _
            (x * dPixelSize / dZoom - _
            (.PlotArea.InsideLeft + .ChartArea.Left)) / _
            .PlotArea.InsideWidth
        dYVal = .Axes(xlValue).MinimumScale + _
            (.Axes(xlValue).MaximumScale - _
            .Axes(xlValue).MinimumScale) * _
            (1 - (y * dPixelSize / dZoom - _
            (.PlotArea.InsideTop + .ChartArea.Top)) / _
            .PlotArea.InsideHeight)
    End With
    Application.StatusBar = "(" & Round(dXVal, 2) & "," & Round(dYVal, 2) & ")"
    'Mouse coordinates to Drawing Object Points
    If Shift = 1 Then
        With mchtChart
            dXVal1 = (x * dPixelSize / dZoom - .ChartArea.Left)
            dYVal1 = (y * dPixelSize / dZoom - .ChartArea.Top)
            With .Shapes(1)
                .Left = dXVal1 - .Width / 2
                .Top = dYVal1 - .Height / 2
            End With
        End With
    End If
End Sub

Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    With Worksheets("Sheet1")
        If .Range("d1") = "" Then
            .Range("d1") = Round(dXVal, 2)
            .Range("e1") = Round(dYVal, 2)
        Else
            .Range("d65536").End(xlUp).Offset(1, 0) = Round(dXVal, 2)
            .Range("e65536").End(xlUp).Offset(1, 0) = Round(dYVal, 2)
        End If
    End With
End Sub

ดูไฟล์แนบประกอบครับ

[tuidento]

ขอขอบคุณมากๆครับ
ขอให้มีแต่ความสุขความเจริญนะครับ

[tuidento]

ขอถามเพิ่มหน่อยครับ ถ้าต้องการให้ msgbox ขึ้นในการคลิ๊กแต่ละครั้ง ซึ่งข้อความไม่เหมือนกันทุกครั้งนะครับ
เราจะเอาคำสั่งmsgbox ไปแทรกตรงไหนครับ

[snasui]

Code ไหนที่ทำงานเมื่อคลิกอันนี้จำเป็นต้องทราบหรือไม่ก็ต้องลองผิดลองถูกมาเอง และเราสามารถแทรก Code ที่ Procedure นั้น การใช้ Code VBA จำเป็นต้องปรับเองได้บ้าง หากปรับเองไม่ได้เลยไม่ควรใช้ VBA หากจำเป็นที่จะต้องใช้จริง ๆ ก็ต้องพึ่งผู้ที่เขียนเป็นเขียนให้ ติดตรงไหนค่อยถามกัน ผมเน้นการแก้ปัญหาเป็นหลักครับ

[tuidento]

ผมลองแก้โดยการใช้จุดseriesเล้กๆแทน
แต่มีปัญหาว่าพอครบทุกจุดแล้ว แต่จุดที่2 ยังเปลี่ยนไปมาอยู่
ทำยังไงให้พอจุดครบ แล้วให้ขึ้นmsgboxแทนครับ

[snasui]

ไม่เข้าใจครับ

ช่วยอธิบายลำดับการทดสอบว่าต้องทำอย่างไร ปัญหาคืออะไร ผลลัพธ์ที่ต้องการคืออะไรมาด้วยครับ

[tuidento]

ผมอยากกำหนดจุดในchart 3จุด ซึ่งค่า x,y ทั้ง3 จุดจะไปแสดงที่ sheet2 เพื่อจะเอาค่า x,y ไปคำนวณต่อ แต่เมื่อclickครบ 3ครั้งแล้ว อยากให้ครั้งที่4 ไปจุดที่จบมีMSGBOXขึ้นมาเตือนครับ

[snasui]

ผมคลิกแล้วไม่มีอะไรเกิดขึ้น ผมต้องทำอะไรก่อนคลิกหรือไม่ ค่าจะไปบันทึกที่ใด ได้เขียน Code การดักจับมาแล้วหรือไม่ว่าหากครบ 3 ครั้งแล้วจะไม่บันทึกอีก Code นั้นชื่อว่าอะไร ติดขัดบรรทัดใดครับ