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

編集履歴

回答編集履歴

7

誤記修正

2021/04/05 23:00

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -50,7 +50,7 @@
50
50
  col顧客.Add "顧客B"
51
51
  col顧客.Add "顧客C"
52
52
  Set pvTable = ActiveSheet.PivotTables(1)
53
- Set pvField = pvTable.PivotFields("NAME")
53
+ Set pvField = pvTable.PivotFields("客先")
54
54
  pvTable.ManualUpdate = True
55
55
 
56
56
  For Each 顧客 In col顧客

6

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

2021/04/05 22:59

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -68,8 +68,10 @@
68
68
  End If
69
69
  Next 顧客
70
70
  pvTable.ManualUpdate = False
71
- If msg <> "" Then
71
+ If msg = "" Then
72
+ MsgBox "印刷完了"
73
+ Else
72
- MsgBox "以下の顧客データが存在しませんでした" & msg, vbExclamation
74
+ MsgBox "印刷完了。以下の顧客データが存在しませんでした" & msg, vbExclamation
73
75
  End If
74
76
  End Sub
75
77
 

5

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

2021/04/05 22:47

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -45,23 +45,32 @@
45
45
  Dim pvField As PivotField
46
46
  Dim col顧客 As New Collection
47
47
  Dim 顧客 As Variant
48
+ Dim msg As String
48
49
  col顧客.Add "顧客A"
49
50
  col顧客.Add "顧客B"
50
51
  col顧客.Add "顧客C"
51
52
  Set pvTable = ActiveSheet.PivotTables(1)
52
53
  Set pvField = pvTable.PivotFields("NAME")
53
54
  pvTable.ManualUpdate = True
54
-
55
+
55
56
  For Each 顧客 In col顧客
57
+ On Error Resume Next
58
+ pvField.PivotItems 顧客
59
+ If Err.Number = 1004 Then
60
+ msg = msg & vbCrLf & 顧客
61
+ On Error GoTo 0
62
+ Else
63
+ On Error GoTo 0
56
- フィルターを設定する pvField, CStr(顧客)
64
+ フィルターを設定する pvField, CStr(顧客)
57
- pvTable.Update
65
+ pvTable.Update
58
- ' ここで印刷処理
66
+ ' ここで印刷処理
59
- 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
67
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
68
+ End If
60
69
  Next 顧客
61
70
  pvTable.ManualUpdate = False
71
+ If msg <> "" Then
72
+ MsgBox "以下の顧客データが存在しませんでした" & msg, vbExclamation
73
+ End If
62
74
  End Sub
63
75
 
64
- ```
76
+ ```
65
-
66
- このままだと対象データがない場合、エラーになるのでその対処とかも
67
- あった方がいいかもですね

4

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

2021/04/05 22:26

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -33,4 +33,35 @@
33
33
 
34
34
  という感じです。
35
35
  印刷は時間がかかるかと思いますが、それは仕方ないとして
36
- それなりにいけるんじゃないかと思います。
36
+ それなりにいけるんじゃないかと思います。
37
+
38
+ 見逃してましたが「自分が担当する客先」分のみ印刷ということであれば
39
+ シートで管理してもいいですが、とりあえず簡単にコード埋め込みで
40
+
41
+
42
+ ```VBA
43
+ Public Sub 印刷2()
44
+ Dim pvTable As PivotTable
45
+ Dim pvField As PivotField
46
+ Dim col顧客 As New Collection
47
+ Dim 顧客 As Variant
48
+ col顧客.Add "顧客A"
49
+ col顧客.Add "顧客B"
50
+ col顧客.Add "顧客C"
51
+ Set pvTable = ActiveSheet.PivotTables(1)
52
+ Set pvField = pvTable.PivotFields("NAME")
53
+ pvTable.ManualUpdate = True
54
+
55
+ For Each 顧客 In col顧客
56
+ フィルターを設定する pvField, CStr(顧客)
57
+ pvTable.Update
58
+ ' ここで印刷処理
59
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
60
+ Next 顧客
61
+ pvTable.ManualUpdate = False
62
+ End Sub
63
+
64
+ ```
65
+
66
+ このままだと対象データがない場合、エラーになるのでその対処とかも
67
+ あった方がいいかもですね

3

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

2021/04/05 21:57

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -29,7 +29,7 @@
29
29
 
30
30
  ```
31
31
  ・全ての顧客で、それぞれ絞れるように関数化しています。
32
- ・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、最後に自動更新を有効にして反映しています。
32
+ ・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、pvTable.Updateにより反映しています。
33
33
 
34
34
  という感じです。
35
35
  印刷は時間がかかるかと思いますが、それは仕方ないとして

2

処理改善

2021/04/05 21:22

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -1,26 +1,32 @@
1
1
  こんなのでどうでしょう。
2
2
 
3
3
  ```VBA
4
- Sub フィルターを設定する(pvTable As PivotTable, itemName As String)
4
+ Sub フィルターを設定する(pvField As PivotField, itemName As String)
5
- pvTable.ManualUpdate = True
5
+ Dim pvItm As PivotItem
6
- pvTable.PivotFields("客先").PivotItems(itemName).Visible = True
6
+ pvField.PivotItems(itemName).Visible = True
7
- For Each pvItm In ActiveSheet.PivotTables(1).PivotFields("客先").PivotItems
7
+ For Each pvItm In pvField.PivotItems
8
8
  If pvItm.Value <> itemName Then
9
9
  pvItm.Visible = False
10
10
  End If
11
11
  Next pvItm
12
- pvTable.ManualUpdate = False
13
12
  End Sub
14
13
 
15
14
  Public Sub 印刷()
15
+ Dim pvTable As PivotTable
16
+ Dim pvField As PivotField
16
17
  Dim pvItm As PivotItem
17
- Dim pvTable As PivotTable
18
18
  Set pvTable = ActiveSheet.PivotTables(1)
19
- For Each pvItm In pvTable.PivotFields("客先").PivotItems
19
+ Set pvField = pvTable.PivotFields("客先")
20
+ pvTable.ManualUpdate = True
21
+ For Each pvItm In pvField.PivotItems
20
- フィルターを設定する pvTable, pvItm.Value
22
+ フィルターを設定する pvField, pvItm.Value
23
+ pvTable.Update
21
24
  ' ここで印刷処理
25
+ 'ActiveSheet.ExportAsFixedFormat xlTypePDF, pvItm.Value & ".pdf"
22
26
  Next pvItm
27
+ pvTable.ManualUpdate = False
23
28
  End Sub
29
+
24
30
  ```
25
31
  ・全ての顧客で、それぞれ絞れるように関数化しています。
26
32
  ・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、最後に自動更新を有効にして反映しています。

1

DoEvents をカット

2021/04/05 21:14

投稿

xail2222
xail2222

スコア1525

answer CHANGED
@@ -8,7 +8,6 @@
8
8
  If pvItm.Value <> itemName Then
9
9
  pvItm.Visible = False
10
10
  End If
11
- DoEvents
12
11
  Next pvItm
13
12
  pvTable.ManualUpdate = False
14
13
  End Sub