vba寫一個南丁格爾玫瑰圖

由於南丁格爾玫瑰圖需要用到極坐標系，因此需要採用自定義圖表類型來繪制。以下是一個簡單的 VBA 代碼示例，可以用於繪制南丁格爾玫瑰圖：

```

Sub DrawNightingale()

    Dim rngData As Range

    Set rngData = Range("B2:B13")  ' 數據範圍

    ' 創建自定義圖表類型

    Dim cht As Chart

    Set cht = Charts.Add

    With cht.ChartArea

        .Clear

        .Format.Fill.Visible = msoFalse  ' 背景填充透明

        .Format.Line.Visible = msoFalse  ' 邊框線不可見

    End With

    cht.ChartType = xlCustom

    cht.ChartStyle = 241

    ' 添加系列數據

    Dim srs As Series

    Set srs = cht.SeriesCollection.NewSeries

    srs.Values = rngData

    srs.ChartType = xlColumnClustered

    srs.ChartType = xlXYScatterLines  ' 設置爲拆線圖

    srs.HasLeaderLines = True

    srs.LeaderLines.Border.ColorIndex = 1  ' 設置引導線顔色

    srs.LeaderLines.Border.Weight = xlThin  ' 設置引導線寬度

    ' 設置系列點位置

    Dim minVal As Double, maxVal As Double

    minVal = WorksheetFunction.Min(rngData)

    maxVal = WorksheetFunction.Max(rngData)

    For i = 1 To rngData.Cells.Count

        Dim r As Double, theta As Double

        Dim val As Double

        val = rngData.Cells(i).Value

        r = (val - minVal) / (maxVal - minVal)  ' 極逕

        theta = (i - 1) / rngData.Cells.Count * 2 * WorksheetFunction.Pi  ' 極角

        srs.Points(i).Format.Line.Visible = msoFalse  ' 點邊框不可見

        srs.Points(i).MarkerStyle = xlMarkerStyleCircle  ' 設置點標記

        srs.Points(i).MarkerSize = 10  ' 設置點大小

        srs.Points(i).MarkerForegroundColor = cht.SeriesCollection(1).Points(i).Format.Fill.ForeColor  ' 按照系列顔色設置點顔色

        srs.Points(i).MarkerBackgroundColor = msoColorAutomatic

        srs.Points(i).Format.Fill.Visible = msoTrue  ' 點填充可見

        srs.Points(i).Left = r * Cos(theta)

        srs.Points(i).Top = r * Sin(theta)

    Next i

    ' 添加坐標軸標簽

    Dim ax As Axis

    Set ax = cht.Axes(xlValue, xlPrimary)

    ax.Delete

    Set ax = cht.Axes(xlCategory, xlPrimary)

    ax.CategoryNames = Range("A2:A13")

    ax.MajorTickMark = xlTickMarkNone

    ax.MinorTickMark = xlTickMarkNone

    ax.Crosses = xlCustom

    ax.CrossesAt = -0.5

    ax.AxisBetweenCategories = True

    ax.TickLabelSpacing = 1

    ax.TickLabels.Orientation = xlUpward

    ax.TickLabels.Font.Size = 10

    ' 添加圖例

    Dim lgd As Legend

    Set lgd = cht.Legend

    lgd.Delete

    ' 調整圖表大小和位置

    cht.Parent.Width = 300

    cht.Parent.Height = 300

    cht.Parent.Left = 200

    cht.Parent.Top = 200

End Sub

```

該代碼可以將 Excel 中 B2:B13 範圍內的數據繪制成南丁格爾玫瑰圖。請注意，該代碼僅適用於 Excel 2010 及以上版本。如果您使用的是較早的 Excel 版本，可能需要進行一些調整。同時，請確保在代碼執行之前選中正確的工作表和數據範圍。

本站是提供個人知識琯理的網絡存儲空間，所有內容均由用戶發佈，不代表本站觀點。請注意甄別內容中的聯系方式、誘導購買等信息，謹防詐騙。如發現有害或侵權內容，請點擊一鍵擧報。