« 2010年5月 | トップページ | 2010年7月 »

2010年6月の5件の記事

2010年6月27日 (日)

第1回マクロ勉強会の資料

ただいまから、マクロの勉強会に行ってきます。

その資料です。今できたところ。

「第1回ワードマクロ勉強会」の配付資料をダウンロード

結果は、後日報告します。

アメブロをご覧ください。

| | コメント (0) | トラックバック (0)

2010年6月15日 (火)

エスパスネットのリンク自動作成マクロのテンプレート

こちらも公開です。

以前のバージョンから大幅なアップデート。

使い方のメニューも表示されます。

ダウンロードはこちらから。

使い方はアメブロの記事をご覧ください。

Espacenettemp

ついでにリンクも充実させました。

Espacenettemp2

| | コメント (0) | トラックバック (0)

右クリックでGoogle!の改良版を公開

ようやく更新できました。

大きな変更はないのですが、マイナーチェンジをしました。

こちらからダウンロードしてください。

マニュアルは「google.pdf」をダウンロード 。PDFが開きます。

| | コメント (0) | トラックバック (0)

2010年6月 6日 (日)

日本語と英語の順序入れ替えマクロ

プログラムの紹介です。

詳細は、こちらのページをご覧ください。

英語を(英1)、(英2)、日本語を(日1)、(日2)とすると

Aandb3

こんな感じで、順序を入れ替えます。

▼プログラム

Sub 順序入れ替えマクロ2()

Dim CP(1 To 5) As Long
Dim myString(1 To 4) As String
Dim mySearch As String  '検索する文字列
Dim myReplace As String '置換後の文字列

'文字列が選択されていない場合には終了
If Selection.Start = Selection.End Then End

'▼選択範囲の先頭の取得
CP(1) = Selection.Start

'▼CP(5)の取得
Selection.Start = Selection.End - 1

Do While Selection.Text = Chr(9) Or Selection.Text = Chr(11) Or _
   Selection.Text = Chr(12) Or Selection.Text = Chr(13)
    Selection.End = Selection.End - 1
    Selection.Start = Selection.End - 1
Loop

CP(5) = Selection.End

'▼CP(4)の取得

'カーソルを選択範囲の先頭に移動
Selection.Start = CP(1)
Selection.End = CP(1)

'検索処理の実行(英1,日1,英2の検索)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([ -~]{1,})([! -~]{1,})([ -~]{1,})"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Execute
    End With
   
    If Selection.Find.Found = True And _
       Selection.Start >= CP(1) And _
       Selection.End <= CP(5) Then
        CP(4) = Selection.End
    Else
        MsgBox "選択範囲が不適切です。"
        Selection.Start = CP(1)
        Selection.End = CP(5)
        End
    End If

'▼CP(2)とCP(3)の取得

'カーソルを対象文字の先頭に移動
Selection.Start = CP(1)
Selection.End = CP(1)

'検索処理の実行(日1の検索)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([! -~]{1,})"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Execute
    End With
   
    If Selection.Find.Found = True And Selection.Start > CP(1) And Selection.End < CP(4) Then
        CP(2) = Selection.Start
        CP(3) = Selection.End
    Else
        MsgBox "選択範囲が不適切です。"
        Selection.Start = CP(1)
        Selection.End = CP(5)
        End
    End If
   
'▼文字列の取得
    Selection.SetRange Start:=CP(1), End:=CP(2)
    myString(1) = Selection.Text
    Selection.SetRange Start:=CP(2), End:=CP(3)
    myString(2) = Selection.Text
    Selection.SetRange Start:=CP(3), End:=CP(4)
    myString(3) = Selection.Text
    Selection.SetRange Start:=CP(4), End:=CP(5)
    myString(4) = Selection.Text

'▼置換処理
'検索する文字列の作成
    mySearch = myString(1) & myString(2) & myString(3) & myString(4)

'置換後の文字列の作成
    myReplace = myString(3) & myString(2) & myString(1)

'カーソルを選択範囲の先頭に移動
    Selection.Start = CP(1)
    Selection.End = CP(1)

'置換処理の実行
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = mySearch
        .Replacement.Text = myReplace
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .Execute Replace:=wdReplaceOne
    End With

'カーソルを、「置換後の文字列の末尾」へ移動
    Selection.Collapse direction:=wdCollapseEnd

'▼検索・置換条件の初期化
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
        .Execute
    End With

End Sub

| | コメント (0) | トラックバック (0)

2010年6月 4日 (金)

シンボルフォントを着色するマクロ

シンボル(Symbol)フォントって、検索できなくないですか?

水野麻子さんの記事「Symbolフォントは危険!」にもあるのですが、ワード上のシンボルフォントって、エディターソフトで文字化けするし、やっかいですね。

そこで、シンボルフォントの一部ではありますが、検索するマクロです。

ギリシャ文字部分(大文字・小文字)をピンクに着色します。

Sub Symbolフォント探し()

Dim SS, SE As Long 'カーソル位置の保存用

'画面更新非表示
    Application.ScreenUpdating = False

'カーソルの現在位置を保存
    SS = Selection.Start
    SE = Selection.End
            
'シンボルフォントのギリシャ文字をピンクの蛍光ペンで着色
For i = 61505 To 61562
If i >= 61531 And i <= 61536 Then GoTo Proc_Skip

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
        .Execute
    End With
   
    Do While Selection.Find.Found = True
        Selection.Range.HighlightColorIndex = wdPink
        Selection.Find.Execute
    Loop
   
Proc_Skip:
Next i

'▼検索・置換条件の初期化
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
        .Execute
    End With

'カーソルの位置を戻す
    Selection.Start = SS
    Selection.End = SE

'画面更新表示
    Application.ScreenUpdating = True
   
End Sub

| | コメント (0) | トラックバック (0)

« 2010年5月 | トップページ | 2010年7月 »