Page 1 of 1

ขออนุญาตช่วยปรับVBAในการสร้างกราฟ

Posted: Tue Oct 29, 2024 6:40 pm
by 9KiTTi
ขออนุญาตช่วยปรับVBAในการสร้างกราฟ ผมใช้ Macro Record ช่วยในการสร้างกราฟและปรับเพิ่มหลังจากนั้น แต่ติดที่ยังหาวิธีเอาข้อมูลปีออกจากแกน X ไม่ได้ รบกวนขอคำแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub CreateChart()

    Dim chartName As String
    chartName = "ChartData"

    Dim myChart As ChartObject
    'ให้สร้างกราฟที่ชีทชื่อ "Chart" เท่านั้น
    Set myChart = Worksheets("Chart").ChartObjects.Add(Left:=10, Width:=375, Top:=10, Height:=225)

    myChart.Width = 1200 'ความกว้าง ห้ามแก้ไข
    myChart.Height = 450 'ความสูง ห้ามแก้ไข

    myChart.Chart.SetSourceData Source:=Sheets("summary").Range("A2:AK7")

    Dim i As Integer
    For i = 1 To 5
        myChart.Chart.FullSeriesCollection(i).Name = "=" & Sheets("summary").Name & "!$A$" & (i + 2) ' A3 to A7
    Next i

    myChart.Chart.SetSourceData Source:=Sheets("summary").Range("A2:A7,B2:AK7")
    myChart.Chart.ClearToMatchStyle
    myChart.Chart.ChartStyle = 206
    myChart.Chart.SetElement (msoElementLegendTop)

    Dim seriesName As String
    For i = 1 To 5
        seriesName = Sheets("summary").Cells(i + 2, 1).Value
        myChart.Chart.FullSeriesCollection(i).Name = seriesName
    Next i

    On Error Resume Next
    If Not myChart.Chart.Axes(xlValue, xlPrimary) Is Nothing Then

        With myChart.Chart.Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.text = "จำนวนเงิน (บาท)"
            With .AxisTitle.Format.TextFrame2.TextRange.Characters
                .Font.Size = 9
                .Fill.ForeColor.RGB = RGB(127, 127, 127)
            End With
        End With
    Else
        MsgBox "ไม่พบแกน Y ที่กำหนด"
    End If
    On Error GoTo 0

    If myChart.Chart.HasTitle Then
        myChart.Chart.ChartTitle.text = "รายงวด"
        With myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Characters
            .text = "รายงวด"
            .ParagraphFormat.TextDirection = msoTextDirectionLeftToRight
            .ParagraphFormat.Alignment = msoAlignCenter
            With .Font
                .Size = 14
                .Fill.ForeColor.RGB = RGB(127, 127, 127)
            End With
        End With
    Else
        myChart.Chart.HasTitle = True
        myChart.Chart.ChartTitle.text = "รายงวด"
    End If

    ' ตั้งค่าชื่อ Chart Area (เอาปีออก)
    On Error Resume Next
    With myChart.Chart.ChartArea
        .HasTitle = True
        .ChartTitle.text = "ข้อมูลการขาย"
        .ChartTitle.Format.TextFrame2.TextRange.Characters.Font.Size = 14
        .ChartTitle.Format.TextFrame2.TextRange.Characters.Fill.ForeColor.RGB = RGB(127, 127, 127)
    End With
    On Error GoTo 0

End Sub

Re: ขออนุญาตช่วยปรับVBAในการสร้างกราฟ

Posted: Thu Oct 31, 2024 5:12 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CreateChart()

    Dim chartName As String, r As Range
    chartName = "ChartData"
    With Worksheets("Summary")
        For Each r In .Range("a3:a7")
            r.Value = " " & r.Value & " "
        Next r
    End With
'Other code

Re: ขออนุญาตช่วยปรับVBAในการสร้างกราฟ

Posted: Thu Oct 31, 2024 6:30 pm
by 9KiTTi
snasui wrote: Thu Oct 31, 2024 5:12 pm :D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CreateChart()

    Dim chartName As String, r As Range
    chartName = "ChartData"
    With Worksheets("Summary")
        For Each r In .Range("a3:a7")
            r.Value = " " & r.Value & " "
        Next r
    End With
'Other code
ผมปรับ code ตามที่อาจารย์แนะนำแล้วครับ แต่ยังมีข้อมูลปีขึ้เหมือนเดิมครับ

Code: Select all

Sub CreateChart()

    Dim chartName As String, r As Range
    Dim myChart As ChartObject
    
    chartName = "ChartData"

    With Worksheets("Summary")
        For Each r In .Range("a3:a7")
            r.Value = " " & r.Value & " "
        Next r
    End With



    'ระบุให้สร้างกราฟที่ชีท "Chart" เท่านั้น
    Set myChart = Worksheets("Chart").ChartObjects.Add(Left:=10, Width:=375, Top:=10, Height:=225)

    myChart.Width = 1200
    myChart.Height = 450

    myChart.Chart.SetSourceData Source:=Sheets("summary").Range("A2:AK7")

    Dim i As Integer
    For i = 1 To 5
        myChart.Chart.FullSeriesCollection(i).Name = "=" & Sheets("summary").Name & "!$A$" & (i + 2) ' A3 to A7
    Next i

    myChart.Chart.SetSourceData Source:=Sheets("summary").Range("A2:A7,B2:AK7")
    myChart.Chart.ClearToMatchStyle
    myChart.Chart.ChartStyle = 206
    myChart.Chart.SetElement (msoElementLegendTop)

    Dim seriesName As String
    For i = 1 To 5
        seriesName = Sheets("summary").Cells(i + 2, 1).Value
        myChart.Chart.FullSeriesCollection(i).Name = seriesName
    Next i

    On Error Resume Next
    If Not myChart.Chart.Axes(xlValue, xlPrimary) Is Nothing Then

        With myChart.Chart.Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.text = "จำนวนเงิน (บาท)"
            With .AxisTitle.Format.TextFrame2.TextRange.Characters
                .Font.Size = 9
                .Fill.ForeColor.RGB = RGB(127, 127, 127)
            End With
        End With
    Else
        MsgBox "ไม่พบแกน Y ที่กำหนด"
    End If
    On Error GoTo 0

    If myChart.Chart.HasTitle Then
        myChart.Chart.ChartTitle.text = "รายงวด"
        With myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Characters
            .text = "รายงวด"
            .ParagraphFormat.TextDirection = msoTextDirectionLeftToRight
            .ParagraphFormat.Alignment = msoAlignCenter
            With .Font
                .Size = 14
                .Fill.ForeColor.RGB = RGB(127, 127, 127)
            End With
        End With
    Else
        myChart.Chart.HasTitle = True
        myChart.Chart.ChartTitle.text = "รายงวด"
    End If

    ' ตั้งค่าชื่อ Chart Area (เอาปีออก)
    On Error Resume Next
    With myChart.Chart.ChartArea
        .HasTitle = True
        .ChartTitle.text = "ข้อมูลการขาย"
        .ChartTitle.Format.TextFrame2.TextRange.Characters.Font.Size = 14
        .ChartTitle.Format.TextFrame2.TextRange.Characters.Fill.ForeColor.RGB = RGB(127, 127, 127)
    End With
    On Error GoTo 0

End Sub

Re: ขออนุญาตช่วยปรับVBAในการสร้างกราฟ

Posted: Thu Oct 31, 2024 7:01 pm
by snasui
:D ปรับการกำหนด Format เพิ่มอีก 1 บรรทัดครับ

Code: Select all

'Other code
With Worksheets("summary")
    For Each r In .Range("a3:a7")
        r.NumberFormat = "@"
        r.Value = " " & r.Value & " "
    Next r
End With
'Other code

Re: ขออนุญาตช่วยปรับVBAในการสร้างกราฟ

Posted: Thu Oct 31, 2024 10:07 pm
by 9KiTTi
ปรับแก้ได้แล้ว ขอบพระคุณครับอาจารย์