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

編集履歴

回答編集履歴

6

修正

2016/09/09 08:07

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -46,7 +46,7 @@
46
46
 
47
47
  Dim shp As Shape
48
48
 
49
- For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.ShapeRange
49
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
50
50
 
51
51
  AutoFontSize shp
52
52
 

5

しゅうせい

2016/09/09 08:07

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -46,7 +46,7 @@
46
46
 
47
47
  Dim shp As Shape
48
48
 
49
- For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
49
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.ShapeRange
50
50
 
51
51
  AutoFontSize shp
52
52
 

4

修正

2016/09/09 08:06

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -42,7 +42,15 @@
42
42
 
43
43
  Sub test()
44
44
 
45
- AutoFontSize ThisDocument.Shapes(1)
45
+ 'AutoFontSize ThisDocument.Shapes(1)
46
+
47
+ Dim shp As Shape
48
+
49
+ For Each shp In ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes 'Range.ShapeRange
50
+
51
+ AutoFontSize shp
52
+
53
+ Next
46
54
 
47
55
  End Sub
48
56
 

3

修正

2016/09/09 08:05

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -42,33 +42,33 @@
42
42
 
43
43
  Sub test()
44
44
 
45
- AutoFontSize Shapes(1)
45
+ AutoFontSize ThisDocument.Shapes(1)
46
46
 
47
47
  End Sub
48
48
 
49
49
 
50
50
 
51
- Sub AutoFontSize(shp as Shape)
51
+ Sub AutoFontSize(shp As Shape)
52
52
 
53
53
  Dim orgH As Double '元の高さ
54
54
 
55
55
  Dim orgW As Double '元の幅
56
56
 
57
-
57
+
58
58
 
59
59
  Dim newH As Double 'AutoSize後の高さ
60
60
 
61
61
  Dim newW As Double 'AutoSize後の幅
62
62
 
63
-
63
+
64
64
 
65
65
  Dim newSize As Double
66
66
 
67
-
67
+
68
68
 
69
69
  Dim addMode As Integer 'サイズ変更モード
70
70
 
71
-
71
+
72
72
 
73
73
  With shp
74
74
 
@@ -78,13 +78,13 @@
78
78
 
79
79
  orgW = .Width
80
80
 
81
-
81
+
82
82
 
83
83
  '元のフォントサイズのままAutoSize
84
84
 
85
85
  .TextFrame.AutoSize = True
86
86
 
87
-
87
+
88
88
 
89
89
  'AutoSize後のサイズを取得
90
90
 
@@ -92,9 +92,9 @@
92
92
 
93
93
  newW = .Width
94
94
 
95
-
96
-
95
+
96
+
97
- If (orgH > newH) And (orgW > newW) Then
97
+ If (orgH >= newH) And (orgW >= newW) Then
98
98
 
99
99
  '幅も高さも小さくなった場合
100
100
 
@@ -108,13 +108,17 @@
108
108
 
109
109
  End If
110
110
 
111
-
111
+
112
112
 
113
113
  '現在のフォントサイズを格納
114
114
 
115
- newSize = .TextFrame2.TextRange.Font.Size
115
+ 'newSize = .TextFrame2.TextRange.Font.Size
116
+
116
-
117
+ shp.Select
118
+
117
-
119
+ newSize = Int(Selection.Font.Size)
120
+
121
+
118
122
 
119
123
  Do
120
124
 
@@ -132,7 +136,13 @@
132
136
 
133
137
  'フォントサイズを+1
134
138
 
135
- .TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size + 1
139
+ '.TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size + 1
140
+
141
+ .TextFrame.AutoSize = False
142
+
143
+ Selection.Font.Size = Selection.Font.Size + 1
144
+
145
+ .TextFrame.AutoSize = True
136
146
 
137
147
  End If
138
148
 
@@ -146,19 +156,25 @@
146
156
 
147
157
  'フォントサイズを-1
148
158
 
149
- .TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size - 1
159
+ '.TextFrame2.TextRange.Font.Size = .TextFrame2.TextRange.Font.Size - 1
160
+
161
+ .TextFrame.AutoSize = False
162
+
163
+ Selection.Font.Size = Selection.Font.Size - 1
164
+
165
+ .TextFrame.AutoSize = True
150
166
 
151
167
  End If
152
168
 
153
169
  End Select
154
170
 
155
-
171
+
156
172
 
157
173
  '変更後のフォントでAutoSize
158
174
 
159
175
  '.TextFrame.AutoSize
160
176
 
161
-
177
+
162
178
 
163
179
  'AutoSize後のサイズを取得
164
180
 
@@ -166,15 +182,15 @@
166
182
 
167
183
  newW = .Width
168
184
 
169
-
170
-
171
-
185
+
186
+
187
+
172
188
 
173
189
  Select Case addMode
174
190
 
175
191
  Case 1 'フォントを上げるモード
176
192
 
177
- If (orgH > newH) And (orgW > newW) Then
193
+ If (orgH >= newH) And (orgW >= newW) Then
178
194
 
179
195
  '幅も高さも小さくなった場合、まだ小さい。⇒ループ継続
180
196
 
@@ -188,13 +204,15 @@
188
204
 
189
205
  Case Else 'フォントを下げるモード
190
206
 
191
- If (orgH > newH) And (orgW > newW) Then
207
+ If (orgH >= newH) And (orgW >= newW) Then
192
208
 
193
209
  '幅も高さも小さくなった場合
194
210
 
195
211
  '現在のフォントサイズが最適。⇒ループ終了
196
212
 
197
- newSize = .TextFrame2.TextRange.Font.Size
213
+ 'newSize = .TextFrame2.TextRange.Font.Size
214
+
215
+ newSize = Selection.Font.Size
198
216
 
199
217
  Exit Do
200
218
 
@@ -206,25 +224,29 @@
206
224
 
207
225
  End Select
208
226
 
209
-
227
+
210
228
 
211
229
  '現在のフォントサイズを格納
212
230
 
213
- newSize = .TextFrame2.TextRange.Font.Size
231
+ 'newSize = .TextFrame2.TextRange.Font.Size
232
+
214
-
233
+ newSize = Selection.Font.Size
215
-
234
+
235
+
216
236
 
217
237
  Loop
218
238
 
219
-
239
+
220
240
 
221
241
  '最適フォントサイズを適用
222
242
 
223
243
  .TextFrame.AutoSize = False
224
244
 
225
- .TextFrame2.TextRange.Font.Size = newSize
245
+ ' .TextFrame2.TextRange.Font.Size = newSize
246
+
226
-
247
+ Selection.Font.Size = newSize
227
-
248
+
249
+
228
250
 
229
251
  '元のサイズに戻す
230
252
 
@@ -232,7 +254,7 @@
232
254
 
233
255
  .Width = orgW
234
256
 
235
-
257
+
236
258
 
237
259
  End With
238
260
 

2

修正

2016/09/09 07:49

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -192,7 +192,7 @@
192
192
 
193
193
  '幅も高さも小さくなった場合
194
194
 
195
- '現在のフォントサイズのフォントサイズが最適。⇒ループ終了
195
+ '現在のフォントサイズが最適。⇒ループ終了
196
196
 
197
197
  newSize = .TextFrame2.TextRange.Font.Size
198
198
 

1

syuusei

2016/09/08 08:59

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -176,7 +176,7 @@
176
176
 
177
177
  If (orgH > newH) And (orgW > newW) Then
178
178
 
179
- '幅も高さも小さくなった場合⇒ループ継続
179
+ '幅も高さも小さくなった場合、まだ小さい。⇒ループ継続
180
180
 
181
181
  Else
182
182
 
@@ -192,7 +192,7 @@
192
192
 
193
193
  '幅も高さも小さくなった場合
194
194
 
195
- '現在のフォントサイズを格納してループ終了
195
+ '現在のフォントサイズのフォントサイズが最適。⇒ループ終了
196
196
 
197
197
  newSize = .TextFrame2.TextRange.Font.Size
198
198
 
@@ -200,7 +200,7 @@
200
200
 
201
201
  Else
202
202
 
203
- '幅または高さが大きくなった場合⇒ループ継続
203
+ '幅または高さが大きくなった場合、まだ大きい。⇒ループ継続
204
204
 
205
205
  End If
206
206