ゴリラストロングの雑記帳

月収10万円の広告収入を目指す自称専業ライターのブログです。




【Excel VBA】データ集計をしてグラフを作成し、ワードに出力するマクロ。




どうも、ゴリラストロングです。

 

今回は、データ集計をしてグラフを作成し、ワードに出力するマクロを作成しました。

 

<動画>


【Excel VBA】エクセルデータからグラフを作成し、ワードに出力するマクロ。【ゴリラストロングの雑記帳】

 

 

<元データ>

f:id:gorilla-strong:20200305111057p:plain

 

 

<マクロ①実行後>

f:id:gorilla-strong:20200305111749p:plain

職能グレードの列に入力がされて、グラフが人数分作成されています。

 

 

<マクロ②実行後>

f:id:gorilla-strong:20200305112435p:plain

f:id:gorilla-strong:20200305112453p:plain

f:id:gorilla-strong:20200305112519p:plain

ワードに各人数分のデータが転記されています。

 

 

 スポンサーリンク

 

 

ソースコード①>

Sub 職能グレード査定()

Dim macro As Object
Set macro = Workbooks("GSZ.xlsm").Worksheets("職能グレード査定")

Dim lastrow As Long
lastrow = macro.Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To lastrow

If macro.Range("H" & i) >= 45 Then
    macro.Range("I" & i) = "S"
ElseIf macro.Range("H" & i) >= 40 And macro.Range("H" & i) < 45 Then
    macro.Range("I" & i) = "A"
ElseIf macro.Range("H" & i) >= 35 And macro.Range("H" & i) < 40 Then
    macro.Range("I" & i) = "B"
ElseIf macro.Range("H" & i) >= 30 And macro.Range("H" & i) < 35 Then
    macro.Range("I" & i) = "C"
ElseIf macro.Range("H" & i) >= 25 And macro.Range("H" & i) < 30 Then
    macro.Range("I" & i) = "D"
Else: macro.Range("I" & i) = "F"

End If

Next

k = 2

For j = 3 To lastrow


Dim fixed, move As Range
Set fixed = macro.Range(Cells(2, 1), Cells(2, 7))
Set move = macro.Range(Cells(j, 1), Cells(j, 7))



With macro.Shapes.AddChart.Chart
    .ChartType = xlRadar
    .SetSourceData Union(fixed, move)
    .ChartStyle = 321
    .HasLegend = False
End With



With macro.ChartObjects(j - 2)
    .Top = macro.Range("K" & k).Top
    .Left = macro.Range("K" & k).Left
    .Height = 300
    .Width = 400
End With

k = k + 17

Next








End Sub

ソースコード②>

Sub ワードに転記()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With








Dim macro As Object
Set macro = Workbooks("GSZ.xlsm").Worksheets("職能グレード査定")

Dim lastrow As Long
lastrow = macro.Cells(Rows.Count, 1).End(xlUp).Row



For i = 3 To lastrow


Dim NewWordObject As Word.Application
Set NewWordObject = New Word.Application

With NewWordObject
    .Visible = True
    .Documents.Add
End With
    

NewWordObject.Selection.Font.Size = 30
s = macro.Range("A1")
NewWordObject.Selection.TypeText Text:=s & "結果通知"


NewWordObject.Selection.TypeParagraph
NewWordObject.Selection.TypeParagraph

snum = macro.Range("A" & i)
NewWordObject.Selection.TypeText Text:="社員番号 " & snum

sname = macro.Range("B" & i)
NewWordObject.Selection.TypeParagraph
NewWordObject.Selection.TypeText Text:="社員名称 " & sname
NewWordObject.Selection.TypeParagraph



macro.ChartObjects(i - 2).Copy

With NewWordObject
    .Selection.PasteSpecial Placement:=wdInLine, _
     DataType:=wdPasteMetafilePicture
    .Selection.ParagraphFormat.Alignment = _
     wdAlignParagraphCenter
   
End With





gname = macro.Range("I" & i)
NewWordObject.Selection.TypeText Text:="あなたの職能グレードは【" & gname & "】です。"






Next







With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With








End Sub

エクセルマクロからワードを操作するのは難しいですね。。。

 

 

以上、ゴリラストロングでした。

 

 

 スポンサーリンク