2017-12-27 11 views
0

グラフテンプレートをマクロに適用することを埋め込み、ヘルプが必要です。それは私が実行するたびに、私が作成したチャートにテンプレートを適用するようにグラフテンプレートをマクロに埋め込む

Option Explicit 

Public Sub Test() 

' Keyboard Shortcut: Ctrl+Shift+X 

Dim wb As Workbook 
Dim ws As Worksheet 

Set wb = ThisWorkbook 
Set ws = wb.Worksheets("Sheet1") '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 

ActiveChart.ApplyChartTemplate (_ 
    "C:\Users\maaro\AppData\Roaming\Microsoft\Templates\Charts\1.crtx") 

End Sub 

そして、上記のコードに以下のコードを埋め込むしたいと思います: 私は散布図を作成するために使用していますマクロのため、このコードを持っていますこのマクロ私の最初の推測は、 "Private Sub BuildCharts"の下に置くことです。どのように私はこれを行うことができるでしょうか?ありがとうございました。

 ActiveChart.ApplyChartTemplate (_ 
    "C:\Users\XXXXX\AppData\Roaming\Microsoft\Templates\Charts\1.crtx") 

答えて

0

おそらく、このようなSub BuildChartを変更:

Private Sub BuildChart(ByRef ws As Worksheet, ByRef unionRng As Range) 

    With ws.Shapes.AddChart2(240, xlXYScatter).Chart 
     .SetSourceData Source:=unionRng 
     .ApplyChartTemplate (_ 
      "C:\Users\maaro\AppData\Roaming\Microsoft\Templates\Charts\1.crtx") 
    End With 

End Sub 
関連する問題