teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問VBAでピボットテーブル　フィールドの選択（抽出）⇒印刷を自動化したい

編集履歴

回答編集履歴

7

誤記修正

2021/04/05 23:00

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -102,7 +102,7 @@
102
102
 
103
103
  Set pvTable = ActiveSheet.PivotTables(1)
104
104
 
105
- Set pvField = pvTable.PivotFields("NAME")
105
+ Set pvField = pvTable.PivotFields("客先")
106
106
 
107
107
  pvTable.ManualUpdate = True
108
108
 

6

正常終了時のメッセージ追記

2021/04/05 22:59

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -138,9 +138,13 @@
138
138
 
139
139
  pvTable.ManualUpdate = False
140
140
 
141
- If msg <> "" Then
141
+ If msg = "" Then
142
142
 
143
+ MsgBox "印刷完了"
144
+
145
+ Else
146
+
143
- MsgBox "以下の顧客データが存在しませんでした" & msg, vbExclamation
147
+ MsgBox "印刷完了。以下の顧客データが存在しませんでした" & msg, vbExclamation
144
148
 
145
149
  End If
146
150
 

5

顧客が存在しなかった場合の処置を追記

2021/04/05 22:47

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -92,6 +92,8 @@
92
92
 
93
93
  Dim 顧客 As Variant
94
94
 
95
+ Dim msg As String
96
+
95
97
  col顧客.Add "顧客A"
96
98
 
97
99
  col顧客.Add "顧客B"
@@ -104,30 +106,46 @@
104
106
 
105
107
  pvTable.ManualUpdate = True
106
108
 
107
-
109
+
108
110
 
109
111
  For Each 顧客 In col顧客
110
112
 
111
- フィルターを設定する pvField, CStr(顧客)
113
+ On Error Resume Next
112
114
 
113
- pvTable.Update
115
+ pvField.PivotItems 顧客
114
116
 
115
- ' ここで印刷処理
117
+ If Err.Number = 1004 Then
116
118
 
119
+ msg = msg & vbCrLf & 顧客
120
+
121
+ On Error GoTo 0
122
+
123
+ Else
124
+
125
+ On Error GoTo 0
126
+
127
+ フィルターを設定する pvField, CStr(顧客)
128
+
129
+ pvTable.Update
130
+
131
+ ' ここで印刷処理
132
+
117
- 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
133
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
134
+
135
+ End If
118
136
 
119
137
  Next 顧客
120
138
 
121
139
  pvTable.ManualUpdate = False
140
+
141
+ If msg <> "" Then
142
+
143
+ MsgBox "以下の顧客データが存在しませんでした" & msg, vbExclamation
144
+
145
+ End If
122
146
 
123
147
  End Sub
124
148
 
125
149
 
126
150
 
127
151
  ```
128
-
129
-
130
-
131
- このままだと対象データがない場合、エラーになるのでその対処とかも
132
-
133
- あった方がいいかもですね

4

見逃し条件(「自分が担当する客先」)に関する補足追記

2021/04/05 22:26

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -69,3 +69,65 @@
69
69
  印刷は時間がかかるかと思いますが、それは仕方ないとして
70
70
 
71
71
  それなりにいけるんじゃないかと思います。
72
+
73
+
74
+
75
+ 見逃してましたが「自分が担当する客先」分のみ印刷ということであれば
76
+
77
+ シートで管理してもいいですが、とりあえず簡単にコード埋め込みで
78
+
79
+
80
+
81
+
82
+
83
+ ```VBA
84
+
85
+ Public Sub 印刷2()
86
+
87
+ Dim pvTable As PivotTable
88
+
89
+ Dim pvField As PivotField
90
+
91
+ Dim col顧客 As New Collection
92
+
93
+ Dim 顧客 As Variant
94
+
95
+ col顧客.Add "顧客A"
96
+
97
+ col顧客.Add "顧客B"
98
+
99
+ col顧客.Add "顧客C"
100
+
101
+ Set pvTable = ActiveSheet.PivotTables(1)
102
+
103
+ Set pvField = pvTable.PivotFields("NAME")
104
+
105
+ pvTable.ManualUpdate = True
106
+
107
+
108
+
109
+ For Each 顧客 In col顧客
110
+
111
+ フィルターを設定する pvField, CStr(顧客)
112
+
113
+ pvTable.Update
114
+
115
+ ' ここで印刷処理
116
+
117
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
118
+
119
+ Next 顧客
120
+
121
+ pvTable.ManualUpdate = False
122
+
123
+ End Sub
124
+
125
+
126
+
127
+ ```
128
+
129
+
130
+
131
+ このままだと対象データがない場合、エラーになるのでその対処とかも
132
+
133
+ あった方がいいかもですね

3

処理改善による補足の齟齬を修正

2021/04/05 21:57

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -60,7 +60,7 @@
60
60
 
61
61
  ・全ての顧客で、それぞれ絞れるように関数化しています。
62
62
 
63
- ・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、最後に自動更新を有効にして反映しています。
63
+ ・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、pvTable.Updateにより反映しています。
64
64
 
65
65
 
66
66
 

2

処理改善

2021/04/05 21:22

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -4,13 +4,13 @@
4
4
 
5
5
  ```VBA
6
6
 
7
- Sub フィルターを設定する(pvTable As PivotTable, itemName As String)
7
+ Sub フィルターを設定する(pvField As PivotField, itemName As String)
8
8
 
9
- pvTable.ManualUpdate = True
9
+ Dim pvItm As PivotItem
10
10
 
11
- pvTable.PivotFields("客先").PivotItems(itemName).Visible = True
11
+ pvField.PivotItems(itemName).Visible = True
12
12
 
13
- For Each pvItm In ActiveSheet.PivotTables(1).PivotFields("客先").PivotItems
13
+ For Each pvItm In pvField.PivotItems
14
14
 
15
15
  If pvItm.Value <> itemName Then
16
16
 
@@ -20,29 +20,41 @@
20
20
 
21
21
  Next pvItm
22
22
 
23
- pvTable.ManualUpdate = False
24
-
25
23
  End Sub
26
24
 
27
25
 
28
26
 
29
27
  Public Sub 印刷()
30
28
 
29
+ Dim pvTable As PivotTable
30
+
31
+ Dim pvField As PivotField
32
+
31
33
  Dim pvItm As PivotItem
32
-
33
- Dim pvTable As PivotTable
34
34
 
35
35
  Set pvTable = ActiveSheet.PivotTables(1)
36
36
 
37
- For Each pvItm In pvTable.PivotFields("客先").PivotItems
37
+ Set pvField = pvTable.PivotFields("客先")
38
38
 
39
+ pvTable.ManualUpdate = True
40
+
41
+ For Each pvItm In pvField.PivotItems
42
+
39
- フィルターを設定する pvTable, pvItm.Value
43
+ フィルターを設定する pvField, pvItm.Value
44
+
45
+ pvTable.Update
40
46
 
41
47
  ' ここで印刷処理
42
48
 
49
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, pvItm.Value & ".pdf"
50
+
43
51
  Next pvItm
44
52
 
53
+ pvTable.ManualUpdate = False
54
+
45
55
  End Sub
56
+
57
+
46
58
 
47
59
  ```
48
60
 

1

DoEvents をカット

2021/04/05 21:14

投稿

xail2222
xail2222

スコア1508

test CHANGED
@@ -17,8 +17,6 @@
17
17
  pvItm.Visible = False
18
18
 
19
19
  End If
20
-
21
- DoEvents
22
20
 
23
21
  Next pvItm
24
22