teratail
回答率
85.30%
質問するログイン新規登録
トップVBAに関する質問VBAでshapeの大きさに合わせてtextのフォントサイズを変更する方法

編集履歴

回答編集履歴

6

修正

2016/09/09 08:07

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -22,7 +22,7 @@
22
22
  Sub test()
23
23
  'AutoFontSize ThisDocument.Shapes(1)
24
24
  Dim shp As Shape
25
- For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.ShapeRange
25
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
26
26
  AutoFontSize shp
27
27
  Next
28
28
  End Sub

5

しゅうせい

2016/09/09 08:07

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -22,7 +22,7 @@
22
22
  Sub test()
23
23
  'AutoFontSize ThisDocument.Shapes(1)
24
24
  Dim shp As Shape
25
- For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
25
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.ShapeRange
26
26
  AutoFontSize shp
27
27
  Next
28
28
  End Sub

4

修正

2016/09/09 08:06

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -20,7 +20,11 @@
20
20
  下記は少し長いですが上記手順をコード化したものです。
21
21
  ```
22
22
  Sub test()
23
- AutoFontSize ThisDocument.Shapes(1)
23
+ 'AutoFontSize ThisDocument.Shapes(1)
24
+ Dim shp As Shape
25
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
26
+ AutoFontSize shp
27
+ Next
24
28
  End Sub
25
29
 
26
30
  Sub AutoFontSize(shp As Shape)

3

修正

2016/09/09 08:05

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -20,43 +20,45 @@
20
20
  下記は少し長いですが上記手順をコード化したものです。
21
21
  ```
22
22
  Sub test()
23
- AutoFontSize Shapes(1)
23
+ AutoFontSize ThisDocument.Shapes(1)
24
24
  End Sub
25
25
 
26
- Sub AutoFontSize(shp as Shape)
26
+ Sub AutoFontSize(shp As Shape)
27
27
  Dim orgH As Double '元の高さ
28
28
  Dim orgW As Double '元の幅
29
-
29
+
30
30
  Dim newH As Double 'AutoSize後の高さ
31
31
  Dim newW As Double 'AutoSize後の幅
32
-
32
+
33
33
  Dim newSize As Double
34
-
34
+
35
35
  Dim addMode As Integer 'サイズ変更モード
36
-
36
+
37
37
  With shp
38
38
  'シェイプの元のサイズを記憶
39
39
  orgH = .Height
40
40
  orgW = .Width
41
-
41
+
42
42
  '元のフォントサイズのままAutoSize
43
43
  .TextFrame.AutoSize = True
44
-
44
+
45
45
  'AutoSize後のサイズを取得
46
46
  newH = .Height
47
47
  newW = .Width
48
-
48
+
49
- If (orgH > newH) And (orgW > newW) Then
49
+ If (orgH >= newH) And (orgW >= newW) Then
50
50
  '幅も高さも小さくなった場合
51
51
  addMode = 1 'フォントを大きくするモード
52
52
  Else
53
53
  '幅または高さが大きくなった場合
54
54
  addMode = 2 'フォントを小さくするモード
55
55
  End If
56
-
56
+
57
57
  '現在のフォントサイズを格納
58
- newSize = .TextFrame2.TextRange.Font.Size
58
+ 'newSize = .TextFrame2.TextRange.Font.Size
59
-
59
+ shp.Select
60
+ newSize = Int(Selection.Font.Size)
61
+
60
62
  Do
61
63
  'サイズ変更
62
64
  Select Case addMode
@@ -65,57 +67,66 @@
65
67
  Exit Do
66
68
  Else
67
69
  'フォントサイズを+1
68
- .TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size + 1
70
+ '.TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size + 1
71
+ .TextFrame.AutoSize = False
72
+ Selection.Font.Size = Selection.Font.Size + 1
73
+ .TextFrame.AutoSize = True
69
74
  End If
70
75
  Case Else 'フォントを下げるモード
71
76
  If newSize < 2 Then
72
77
  Exit Do
73
78
  Else
74
79
  'フォントサイズを-1
75
- .TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size - 1
80
+ '.TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size - 1
81
+ .TextFrame.AutoSize = False
82
+ Selection.Font.Size = Selection.Font.Size - 1
83
+ .TextFrame.AutoSize = True
76
84
  End If
77
85
  End Select
78
-
86
+
79
87
  '変更後のフォントでAutoSize
80
88
  '.TextFrame.AutoSize
81
-
89
+
82
90
  'AutoSize後のサイズを取得
83
91
  newH = .Height
84
92
  newW = .Width
85
-
86
-
93
+
94
+
87
95
  Select Case addMode
88
96
  Case 1 'フォントを上げるモード
89
- If (orgH > newH) And (orgW > newW) Then
97
+ If (orgH >= newH) And (orgW >= newW) Then
90
98
  '幅も高さも小さくなった場合、まだ小さい。⇒ループ継続
91
99
  Else
92
100
  '大きくなりすぎた為、前回のフォントサイズが最適。⇒ループ終了
93
101
  Exit Do
94
102
  End If
95
103
  Case Else 'フォントを下げるモード
96
- If (orgH > newH) And (orgW > newW) Then
104
+ If (orgH >= newH) And (orgW >= newW) Then
97
105
  '幅も高さも小さくなった場合
98
106
  '現在のフォントサイズが最適。⇒ループ終了
99
- newSize = .TextFrame2.TextRange.Font.Size
107
+ 'newSize = .TextFrame2.TextRange.Font.Size
108
+ newSize = Selection.Font.Size
100
109
  Exit Do
101
110
  Else
102
111
  '幅または高さが大きくなった場合、まだ大きい。⇒ループ継続
103
112
  End If
104
113
  End Select
105
-
114
+
106
115
  '現在のフォントサイズを格納
107
- newSize = .TextFrame2.TextRange.Font.Size
116
+ 'newSize = .TextFrame2.TextRange.Font.Size
108
-
117
+ newSize = Selection.Font.Size
118
+
109
119
  Loop
110
-
120
+
111
121
  '最適フォントサイズを適用
112
122
  .TextFrame.AutoSize = False
113
- .TextFrame2.TextRange.Font.Size = newSize
123
+ ' .TextFrame2.TextRange.Font.Size = newSize
114
-
124
+ Selection.Font.Size = newSize
125
+
115
126
  '元のサイズに戻す
116
127
  .Height = orgH
117
128
  .Width = orgW
118
-
129
+
119
130
  End With
120
131
 
121
132
  End Sub

2

修正

2016/09/09 07:49

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -95,7 +95,7 @@
95
95
  Case Else 'フォントを下げるモード
96
96
  If (orgH > newH) And (orgW > newW) Then
97
97
  '幅も高さも小さくなった場合
98
- '現在のフォントサイズのフォントサイズが最適。⇒ループ終了
98
+ '現在のフォントサイズが最適。⇒ループ終了
99
99
  newSize = .TextFrame2.TextRange.Font.Size
100
100
  Exit Do
101
101
  Else

1

syuusei

2016/09/08 08:59

投稿

jawa
jawa

スコア3021

answer CHANGED
@@ -87,7 +87,7 @@
87
87
  Select Case addMode
88
88
  Case 1 'フォントを上げるモード
89
89
  If (orgH > newH) And (orgW > newW) Then
90
- '幅も高さも小さくなった場合⇒ループ継続
90
+ '幅も高さも小さくなった場合、まだ小さい。⇒ループ継続
91
91
  Else
92
92
  '大きくなりすぎた為、前回のフォントサイズが最適。⇒ループ終了
93
93
  Exit Do
@@ -95,11 +95,11 @@
95
95
  Case Else 'フォントを下げるモード
96
96
  If (orgH > newH) And (orgW > newW) Then
97
97
  '幅も高さも小さくなった場合
98
- '現在のフォントサイズを格納してループ終了
98
+ '現在のフォントサイズのフォントサイズが最適。⇒ループ終了
99
99
  newSize = .TextFrame2.TextRange.Font.Size
100
100
  Exit Do
101
101
  Else
102
- '幅または高さが大きくなった場合⇒ループ継続
102
+ '幅または高さが大きくなった場合、まだ大きい。⇒ループ継続
103
103
  End If
104
104
  End Select
105
105