我需要在excel上创建许多图表,因为我有很多套数字。理想情况下,我想创建一个散点图,我是学习如何使用excel和VBA的新手。
我想创建一个模板模块代码来生成散点图,我可以为彼此不相邻的列或行选择X和Y值。此外,我希望能够格式化剧情的细节 - 字体,大小等。
有人可以帮我创建一个简单的模板吗?谢谢。
我试过这样做。我本质上希望能够多次使用此宏来生成具有相同格式的许多散点图,但每次都选择不同的X和Y值。
我可以添加哪些代码,以便在运行时提示我选择所需的X和Y值?
Sub Macro8()
'
' Macro8 Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
' Dim rng As Range
Set rng = Application.InputBox(prompt:="Sample", Type:=8)
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines).Select
ActiveChart.SetSourceData Source:=rng
End Sub
答案 0 :(得分:0)
这有点粗糙并准备就绪,但显示了一些想法。如果在通过此设备进入时出现任何拼写错误,并且您肯定希望实现更好的错误处理,请致歉。
Option Explicit
Public Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Data") 'change as appropriate
Application.ScreenUpdating = False
BuildChart ws, SelectRanges(ws)
Application.ScreenUpdating = True
End Sub
Private Function SelectRanges(ByRef ws As Worksheet) As Range
Dim rngX As Range
Dim rngY As Range
ws.Activate
Application.DisplayAlerts = False
On Error Resume Next
Set rngX = Application.InputBox("Please select X values. One column.", Type:=8)
If rngX Is Nothing Then GoTo InvalidSelection
Set rngY = Application.InputBox("Please select Y values. One column.", Type:=8)
If rngY Is Nothing Then GoTo InvalidSelection
If rngX.Columns.Count > 1 Or rngY.Columns.Count > 1 Then GoTo InvalidSelection
On Error GoTo 0
Set SelectRanges = Union(rngX, rngY)
Application.DisplayAlerts = True
Exit Function
InvalidSelection:
If rngX Is Nothing Or rngY Is Nothing Then
MsgBox "Please ensure you have selected both X and Y ranges."
ElseIf rngX.Rows.Count <> rngX.Rows.Count Then
MsgBox "Please ensure the same number of rows are selected for X and Y ranges"
ElseIf rngX.Columns.Count > 1 Or rngY.Columns.Count > 1 Then
MsgBox "Please ensure X range has only one column and Y range has only one column"
Else
MsgBox "Unspecified"
End If
Application.DisplayAlerts = True
End
End Function
Private Sub BuildChart(ByRef ws As Worksheet, ByRef unionRng As Range)
With ws.Shapes.AddChart2(240, xlXYScatter).Chart
.SetSourceData Source:=unionRng
End With
End Sub