teratail
回答率
85.25%
質問するログイン新規登録
トップExcelVBAにて図の挿入について

編集履歴

回答編集履歴

11

On error goto はエラー箇所の出現位置が分からなくなるので削除

2023/09/18 21:08

投稿

退会済みユーザー
answer CHANGED
@@ -12,8 +12,6 @@
12
12
  '途中でコメントアウトしているSleep関数を使う場合は↑のコメントを外す
13
13
 
14
14
  Public Sub 正方形選択()
15
-
16
- On Error GoTo ErrorLabel
17
15
 
18
16
  Dim uia As New CUIAutomation
19
17
  Dim rootElement As IUIAutomationElement
@@ -41,10 +39,6 @@
41
39
  Set invokePattern = element.GetCurrentPattern(UIA_SelectionItemPatternId)
42
40
  invokePattern.Select
43
41
 
44
-
45
- ErrorLabel:
46
- Debug.Print Err.Number & " " & Err.Description
47
-
48
42
  End Sub
49
43
 
50
44
 
@@ -69,7 +63,7 @@
69
63
 
70
64
  If element Is Nothing Then
71
65
  Set GetSayGOChildElement = Nothing
72
- Call Err.Raise(90000, "GetSayGOChildElement", "エラー：名前:「" & elementName & "」、クラス名「" & className & "」に該当するエレメントが見つかりませんでした")
66
+ Debug.Print "エラー：名前:「" & elementName & "」、クラス名「" & className & "」に該当するエレメントが見つかりませんでした")
73
67
  End If
74
68
  Set GetSayGOChildElement = element
75
69
 

10

ｃ

2023/09/18 21:02

投稿

退会済みユーザー
answer CHANGED
@@ -20,7 +20,7 @@
20
20
  Set rootElement = uia.GetRootElement
21
21
 
22
22
  Dim element As IUIAutomationElement
23
- ' 以下は環境依存。inspecter.exeなどで調べる。
23
+ '以下は環境依存。inspecter.exeなどで調べる。
24
24
  Set element = GetSayGOChildElement(uia, rootElement, "図形", "NetUIAnchor")
25
25
  '図形メニューペーンを展開する。
26
26
  Dim menupane As IUIAutomationExpandCollapsePattern

9

ｆ

2023/09/18 21:02

投稿

退会済みユーザー
answer CHANGED
@@ -20,6 +20,7 @@
20
20
  Set rootElement = uia.GetRootElement
21
21
 
22
22
  Dim element As IUIAutomationElement
23
+ ' 以下は環境依存。inspecter.exeなどで調べる。
23
24
  Set element = GetSayGOChildElement(uia, rootElement, "図形", "NetUIAnchor")
24
25
  '図形メニューペーンを展開する。
25
26
  Dim menupane As IUIAutomationExpandCollapsePattern
@@ -34,7 +35,8 @@
34
35
  Set element = GetSayGOChildElement(uia, element, "図形", "NetUIGalleryContainer")
35
36
  Set element = GetSayGOChildElement(uia, element, "四角形", "NetUIGalleryCategoryContainer")
36
37
  Set element = GetSayGOChildElement(uia, element, "正方形/長方形", "NetUIGalleryButton")
38
+
37
-
39
+ 'IUIAutomationInvokePattern だと図形が挿入されてしまう。
38
40
  Dim invokePattern As IUIAutomationSelectionItemPattern
39
41
  Set invokePattern = element.GetCurrentPattern(UIA_SelectionItemPatternId)
40
42
  invokePattern.Select

8

ｇ

2023/09/18 20:57

投稿

退会済みユーザー
answer CHANGED
@@ -1,6 +1,6 @@
1
1
  質問中にあるようなコードは、リボン内のメニュー構造にかなり依存します。
2
2
  つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、バージョンごとにinspecter等で構造を調べコードを適切に組み替えないとすぐ動かなくなります。
3
- （ですので、この手のオートメーションを自作で行うのは茨の道と思っています。個人的に。）
3
+ （構造だけではなく、処理依存で出現するモーダルダイアログの処理や、コンポーネントごとにクリックや選択の挙動が全然異なるということもあります。ですので個人的にこの手のオートメーションを自作で行うのは茨の道と思っています。）
4
4
 
5
5
  なお下記は参考として、自分の環境（Windows 11 Pro 64bit のMicrosoft 365 EXCEL バージョン2308）で動くコードです。
6
6
  （実行するとカーソルが十字になって四角形描画モードになります）

7

ｔ

2023/09/18 20:54

投稿

退会済みユーザー
answer CHANGED
@@ -1,5 +1,5 @@
1
1
  質問中にあるようなコードは、リボン内のメニュー構造にかなり依存します。
2
- つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、自分でinspecter等で構造を調べコードを適切に組み替えないとすぐ動かなくなります。
2
+ つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、バージョンごとにinspecter等で構造を調べコードを適切に組み替えないとすぐ動かなくなります。
3
3
  （ですので、この手のオートメーションを自作で行うのは茨の道と思っています。個人的に。）
4
4
 
5
5
  なお下記は参考として、自分の環境（Windows 11 Pro 64bit のMicrosoft 365 EXCEL バージョン2308）で動くコードです。

6

ｆ

2023/09/18 20:54

投稿

退会済みユーザー
answer CHANGED
@@ -1,6 +1,6 @@
1
1
  質問中にあるようなコードは、リボン内のメニュー構造にかなり依存します。
2
- つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、自分でinspecter等で構造を調べコードを適切に組み替える力がないと到底動かせません。
2
+ つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、自分でinspecter等で構造を調べコードを適切に組み替えないとすぐ動かなくなります。
3
- こうしたコードを利用しようとするなら、そういう覚悟を持ってください。
3
+ （ですので、この手のオートメーションを自作で行うのは茨の道と思っています。個人的に。）
4
4
 
5
5
  なお下記は参考として、自分の環境（Windows 11 Pro 64bit のMicrosoft 365 EXCEL バージョン2308）で動くコードです。
6
6
  （実行するとカーソルが十字になって四角形描画モードになります）

5

ｖ

2023/09/18 12:50

投稿

退会済みユーザー
answer CHANGED
@@ -66,7 +66,7 @@
66
66
  Set element = parentElement.FindFirst(TreeScope_Subtree, cndNameAndClassName)
67
67
 
68
68
  If element Is Nothing Then
69
- Set GetChildElement = Nothing
69
+ Set GetSayGOChildElement = Nothing
70
70
  Call Err.Raise(90000, "GetSayGOChildElement", "エラー：名前:「" & elementName & "」、クラス名「" & className & "」に該当するエレメントが見つかりませんでした")
71
71
  End If
72
72
  Set GetSayGOChildElement = element

4

ｓ

2023/09/18 12:48

投稿

退会済みユーザー
answer CHANGED
@@ -7,7 +7,10 @@
7
7
 
8
8
 
9
9
  ```vb
10
+
10
- 'Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '後述のSleep関数を使う場合はここのコメントを外す
11
+ 'Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
12
+ '途中でコメントアウトしているSleep関数を使う場合は↑のコメントを外す
13
+
11
14
  Public Sub 正方形選択()
12
15
 
13
16
  On Error GoTo ErrorLabel
@@ -23,7 +26,7 @@
23
26
  Set menupane = element.GetCurrentPattern(UIA_ExpandCollapsePatternId)
24
27
  menupane.expand
25
28
 
26
- 'Sleep 100 'うまく選択されない場合はここのコメントを外して調整。
29
+ 'Sleep 100 'うまく選択されない場合はここと冒頭のコメントを外して調整。
27
30
  DoEvents 'クリック扱いになるのを防ぐ。
28
31
 
29
32
  ' 以下は環境依存。inspecter.exeなどで調べる。

3

ｗ

2023/09/18 12:47

投稿

退会済みユーザー
answer CHANGED
@@ -2,11 +2,12 @@
2
2
  つまり、異なるバージョンのエクセル（アップデート含む）では、メニュー構造やクラス名が異なってしまうため、自分でinspecter等で構造を調べコードを適切に組み替える力がないと到底動かせません。
3
3
  こうしたコードを利用しようとするなら、そういう覚悟を持ってください。
4
4
 
5
- なお下記は参考として、自分の環境（WindowsのMicrosoft 365 EXCEL バージョン2308）で動くコードです。
5
+ なお下記は参考として、自分の環境（Windows 11 Pro 64bit のMicrosoft 365 EXCEL バージョン2308）で動くコードです。
6
6
  （実行するとカーソルが十字になって四角形描画モードになります）
7
7
 
8
8
 
9
9
  ```vb
10
+ 'Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '後述のSleep関数を使う場合はここのコメントを外す
10
11
  Public Sub 正方形選択()
11
12
 
12
13
  On Error GoTo ErrorLabel

2

修正

2023/09/18 12:40

投稿

退会済みユーザー
answer CHANGED
@@ -17,16 +17,15 @@
17
17
 
18
18
  Dim element As IUIAutomationElement
19
19
  Set element = GetSayGOChildElement(uia, rootElement, "図形", "NetUIAnchor")
20
-
21
20
  '図形メニューペーンを展開する。
22
21
  Dim menupane As IUIAutomationExpandCollapsePattern
23
22
  Set menupane = element.GetCurrentPattern(UIA_ExpandCollapsePatternId)
24
23
  menupane.expand
25
24
 
26
25
  'Sleep 100 'うまく選択されない場合はここのコメントを外して調整。
27
- DoEvents
26
+ DoEvents 'クリック扱いになるのを防ぐ。
28
27
 
29
- ' 以下は環境依存。inspector.exeなどで調べる。
28
+ ' 以下は環境依存。inspecter.exeなどで調べる。
30
29
  Set element = GetSayGOChildElement(uia, element, "図形", "NetUIToolWindow")
31
30
  Set element = GetSayGOChildElement(uia, element, "図形", "NetUIGalleryContainer")
32
31
  Set element = GetSayGOChildElement(uia, element, "四角形", "NetUIGalleryCategoryContainer")
@@ -35,12 +34,14 @@
35
34
  Dim invokePattern As IUIAutomationSelectionItemPattern
36
35
  Set invokePattern = element.GetCurrentPattern(UIA_SelectionItemPatternId)
37
36
  invokePattern.Select
38
-
37
+
38
+
39
39
  ErrorLabel:
40
40
  Debug.Print Err.Number & " " & Err.Description
41
41
 
42
42
  End Sub
43
43
 
44
+
44
45
  '指定したエレメント名、クラス名に該当する子要素を返す
45
46
  Private Function GetSayGOChildElement( _
46
47
  ByRef uia As CUIAutomation, _
@@ -59,12 +60,12 @@
59
60
  Set cndClassName = uia.CreatePropertyCondition(UIA_ClassNamePropertyId, className)
60
61
  Set cndNameAndClassName = uia.CreateAndCondition(cndName, cndClassName)
61
62
  Set element = parentElement.FindFirst(TreeScope_Subtree, cndNameAndClassName)
62
-
63
+
63
64
  If element Is Nothing Then
64
65
  Set GetChildElement = Nothing
65
- Call Err.Raise(90000, "GetChildElement", "エラー：名前:「" & elementName & "」、クラス名「" & className & "」に該当するエレメントが見つかりませんでした")
66
+ Call Err.Raise(90000, "GetSayGOChildElement", "エラー：名前:「" & elementName & "」、クラス名「" & className & "」に該当するエレメントが見つかりませんでした")
66
67
  End If
67
- Set GetChildElement = element
68
+ Set GetSayGOChildElement = element
68
69
 
69
70
  End Function
70
71
  ```

1

fix

2023/09/18 12:30

投稿

退会済みユーザー
answer CHANGED
@@ -32,9 +32,9 @@
32
32
  Set element = GetSayGOChildElement(uia, element, "四角形", "NetUIGalleryCategoryContainer")
33
33
  Set element = GetSayGOChildElement(uia, element, "正方形/長方形", "NetUIGalleryButton")
34
34
 
35
- Dim invokePatgtern As IUIAutomationSelectionItemPattern
35
+ Dim invokePattern As IUIAutomationSelectionItemPattern
36
- Set invokePatgtern = element.GetCurrentPattern(UIA_SelectionItemPatternId)
36
+ Set invokePattern = element.GetCurrentPattern(UIA_SelectionItemPatternId)
37
- invokePatgtern.Select
37
+ invokePattern.Select
38
38
 
39
39
  ErrorLabel:
40
40
  Debug.Print Err.Number & " " & Err.Description