|
フォントの一括変更 |
- 01: 名前：yoda投稿日：2007/11/08(木) 14:15
- 以前、フォントの変更で、質問があったとき、すべてのフォントを
一括変更する場合は、すべてのシェイプについて、ループを組んで、
処理する案を出しましたが、シェイプがグループになっていたりすると、
処理が少し複雑になる上、シェイプの数が多いと、時間もかかりそう
な、あまりよくない案でした。
私たちが、Visiono図面の上で、手動でフォントを、一括で変更したい
ときは、普通は、すべてのシェイプを選択し、ツールバーでフォント
を変えるだけで、瞬時にフォントを、一括変更できます。
それと、同じようなことをするマクロを、作ってみました。
手動でフォントを変更するときのように、素早く一括変更できます。
このサンプルマクロは、今開いているページのシェイプを、すべて選択
して、ツールバーのフォントを選択することによって、シェイプのフォント
を一括変更します。このマクロは、OfficeのCommandBarオブジェクト
を使うので、Microsoft Office Object Library を参照設定に加えて
おく必要があります。
Option Explicit
Sub test()
Dim myFont As String
ActiveWindow.SelectAll
myFont = InputBox("Enter font", "Font", "Arial Black")
ChangeAllFont myFont
End Sub
Public Sub ChangeAllFont(Font As String)
Dim cbars As Office.CommandBars
Dim cbar As Office.CommandBar
Dim cbButton As Office.CommandBarButton
Dim cbCombo As Office.CommandBarComboBox
Dim cbc As Office.CommandBarControl
On Error GoTo ERRHAND
Set cbars = Application.CommandBars
For Each cbar In cbars
If cbar.Name = "Formatting" Then
For Each cbc In cbar.Controls
If cbc.ID = 1728 Then 'Font selection ComboBox
Set cbCombo = cbc
' MsgBox "Font is changing to " & Font
cbCombo.Text = Font
End If
Next
End If
Next
Exit Sub
ERRHAND:
MsgBox Err.Description
End Sub
- 02: 名前：yoda投稿日：2007/11/09(金) 08:40
- このマクロは、ＦｏｎｔセルがＧＵＲD関数で保護されているシェイプの
フォントは、変更してくれません。そこで、以下のようなマクロを、
作ってみましたが、はたしてどうでしょう。これも、欠点だらけだと
思いますが、なにもかもできるマクロなど、ないとも思いますし。
Option Explicit
Sub test()
On Error GoTo ERREND
Dim shp As Visio.Shape
Dim I As Long, N As Long
N = 999
For I = 1 To N
Set shp = ActivePage.Shapes.ItemFromID(I)
' Debug.Print I, shp.Index, shp.Name
shp.CellsSRC(visSectionCharacter, visRowCharacter, _
visCharacterFont).ResultForce("") = 3
Next
Exit Sub
ERREND:
MsgBox Err.Description & " " & I - 1 & " is Less than " & N
End Sub
- 03: 名前：yoda投稿日：2007/11/09(金) 19:58
- 01と02のマクロの、処理速度の比較ですが、シェイプの数が多い場合、
なんと、02のマクロの方が、体感では、早いような気がします。
|
|