回答編集履歴

1

削除

2022/06/20 14:27

投稿

jinoji
jinoji

スコア4585

test CHANGED
@@ -1,50 +1,4 @@
1
1
  ```
2
+  
2
- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
3
+ ```
3
4
 
4
- Dim StartX As Single
5
- Dim StartY As Single
6
- Dim EndX As Single
7
- Dim EndY As Single
8
-
9
-
10
- With Target
11
-
12
- 'Targetの左端
13
- StartX = .Left
14
-
15
- 'Targetの上端
16
- StartY = .Top
17
-
18
- 'Targetの横幅
19
- EndX = 20
20
-
21
- 'Targetの高さ
22
- EndY = 20
23
-
24
- '既存番号取得
25
- Dim s As Shape, num As Long
26
- For Each s In ActiveSheet.Shapes
27
- If s.AutoShapeType = msoShapeOvalCallout Then
28
- If CLng(s.TextFrame.Characters.Text) > num Then num = CLng(s.TextFrame.Characters.Text)
29
- End If
30
- Next
31
-
32
- '図形挿入
33
- With ActiveSheet.Shapes.AddShape(msoShapeOvalCallout, StartX, StartY, EndX, EndY)
34
-
35
- With .TextFrame.Characters 'テキスト
36
-
37
- .Text = CStr(num + 1) '文字列
38
- .Font.Size = 10 '文字のサイズ
39
- .Font.Bold = True
40
-
41
- End With
42
-
43
- End With
44
-
45
- Cancel = True
46
-
47
- End With
48
-
49
- End Sub
50
- ```