02

USキーボードの日本語入力

日本語配列キーボードであれば、Windows（キーとタッチのカスタマイズ）で設定をすれば、変換/無変換キーでIMEのオン/オフ制御ができ、日本語入力と英語入力の切り替えができますが、英語配列キーボードには、変換/無変換キーがありません。唯一の（と思われる）手段として、IME-オン/オフをCtrl+ […]

公開済み: 2020年9月2日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード
タグ: USキーボード, 使いにくい, 英字配列キーボード

VBSで商標検索

J-PlatPatにアクセスして商標を検索することができるVBSを作成しました。使用する際には、メモ帳等にコピペし、ファイルの拡張子をVBSにします。商標の検索方法（VBS）のページもご参照ください。

Option Explicit
Const strIE = "iexplore.exe"
Dim searchWord
Dim similarCode
Dim wtime

'待機時間を設定します（ミリ秒）
wtime = 50

'称呼と類似群コードを入力します
searchWord = InputBox("称呼を全角カナで入力してください。" & vbCr & "例：トッキョチョー")
similarCode = InputBox("（任意入力）類似群コードを半角英数で入力してください。" & vbCr & "例：29B01")

'キーワードが空でなければ処理を開始します
If searchWord <> "" Then

    Dim ws
    Set ws = WScript.CreateObject("Wscript.Shell")
    
    'IEでJPlatPat商標検索にアクセス
    Dim ie
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Navigate "https://www.j-platpat.inpit.go.jp/t0100"
    ie.Visible = True
    waitIE ie
    
    'プロセスIDを取得し、IEをアクティブにします
    Dim locater, connect, instances, instance
    Dim PID
    Set locater = CreateObject("WbemScripting.SWbemLocator")
    Set connect = locater.ConnectServer
    Set instances = connect.InstancesOf("Win32_Process")
    
    For Each instance In instances
        If Not IsEmpty(instance.processID) And instance.Description = "iexplore.exe" Then
            PID = instance.processID
        End If
    Next
    
    Set locater = Nothing
    Set instances = Nothing
    Set connect = Nothing
    
    While Not ws.AppActivate(PID)
        WScript.Sleep wtime
    Wend
    
    '検索項目を「称呼（類似検索）」にセットします
    ie.Document.getElementById("t01_srchCondtn_mk_selSearchItem1").Click
    
    WScript.Sleep wtime
    ws.SendKeys "{DOWN}"
    WScript.Sleep wtime
    ws.SendKeys "{ENTER}"
    waitIE ie
        
    'キーワードをセットします
    ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Click
    ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Focus
    ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Value = searchWord
    
    WScript.Sleep wtime
    ws.SendKeys "{ENTER}"
    waitIE ie
    
    '類似群コードの入力があるときセットします
    If similarCode <> "" Then
        ie.Document.getElementById("t01_srchCondtn_goods_selSearchItem0").Click
        
        WScript.Sleep wtime
        ws.SendKeys "{ENTER}"
        waitIE ie
        
        ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Click
        ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Focus
        ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Value = similarCode
        
        WScript.Sleep wtime
        ws.SendKeys "{ENTER}"
        waitIE ie
    End If
    
    '検索ボタンをクリック
    ie.Document.getElementById("t01_srchBtn_btnSearch").Click
    
    Set ie = Nothing
    Set ws = Nothing
End If

Sub waitIE(ie)
'アクセス完了まで待機
Do While ie.Busy = True Or ie.readystate <> 4
    WScript.Sleep 50
Loop
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

Option Explicit

Const strIE = "iexplore.exe"

Dim searchWord

Dim similarCode

Dim wtime

'待機時間を設定します（ミリ秒）

wtime = 50

'称呼と類似群コードを入力します

searchWord = InputBox("称呼を全角カナで入力してください。" & vbCr & "例：トッキョチョー")

similarCode = InputBox("（任意入力）類似群コードを半角英数で入力してください。" & vbCr & "例：29B01")

'キーワードが空でなければ処理を開始します

If searchWord <> "" Then

Dim ws

Set ws = WScript.CreateObject("Wscript.Shell")

'IEでJPlatPat商標検索にアクセス

Dim ie

Set ie = CreateObject("InternetExplorer.Application")

ie.Navigate "https://www.j-platpat.inpit.go.jp/t0100"

ie.Visible = True

waitIE ie

'プロセスIDを取得し、IEをアクティブにします

Dim locater, connect, instances, instance

Dim PID

Set locater = CreateObject("WbemScripting.SWbemLocator")

Set connect = locater.ConnectServer

Set instances = connect.InstancesOf("Win32_Process")

For Each instance In instances

If Not IsEmpty(instance.processID) And instance.Description = "iexplore.exe" Then

PID = instance.processID

End If

Set instances = Nothing

Set connect = Nothing

While Not ws.AppActivate(PID)

WScript.Sleep wtime

Wend

'検索項目を「称呼（類似検索）」にセットします

ie.Document.getElementById("t01_srchCondtn_mk_selSearchItem1").Click

WScript.Sleep wtime

ws.SendKeys "{DOWN}"

WScript.Sleep wtime

ws.SendKeys "{ENTER}"

waitIE ie

'キーワードをセットします

ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Click

ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Focus

ie.Document.getElementById("t01_srchCondtn_mk_txtKeywd1").Value = searchWord

WScript.Sleep wtime

ws.SendKeys "{ENTER}"

waitIE ie

'類似群コードの入力があるときセットします

If similarCode <> "" Then

ie.Document.getElementById("t01_srchCondtn_goods_selSearchItem0").Click

WScript.Sleep wtime

ws.SendKeys "{ENTER}"

waitIE ie

ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Click

ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Focus

ie.Document.getElementById("t01_srchCondtn_goods_txtKeywd0").Value = similarCode

WScript.Sleep wtime

ws.SendKeys "{ENTER}"

waitIE ie

End If

'検索ボタンをクリック

ie.Document.getElementById("t01_srchBtn_btnSearch").Click

Set ie = Nothing

Set ws = Nothing

End If

Sub waitIE(ie)

'アクセス完了まで待機

Do While ie.Busy = True Or ie.readystate <> 4

WScript.Sleep 50

Loop

End Sub

このVBSは、インターネッ […]

公開済み: 2019年7月16日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: VBS, 商標

句読点まで一気に選択したいときに

文を書いたり修正したりしていると、カーソルの移動に時間がかかることがあります。例えば、現在のカーソル位置から次の句読点までの部分を削除したいとき、Shiftを押しながら右矢印キーカタカタを叩いて句読点まで選択して削除をします。僅かな時間ですが、積み重なると大きな時間になります。このときに、次の句読 […]

公開済み: 2019年3月15日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

英字・数字・括弧の色を変えたいときに

符号等を記載するとき、英字や数字、括弧を使用します。これらの色を変えると、文のチェックがより容易になります。そこで、英字や数字、括弧の色を変えるマクロを作成しました。

Sub 英字数字括弧いろかはれ()
Dim 英字ギリシャ文字 As String: 英字ギリシャ文字 = "[Ａ-Ｚａ-ｚA-Za-zΑ-Ωα-ω]"
Dim 数字 As String: 数字 = "[０-９0-9]"
Dim 括弧 As String: 括弧 = "[（*）]"

Call 着色する(英字ギリシャ文字, wdColorDarkRed)
Call 着色する(数字, wdColorAqua)
Call 着色する(括弧, wdColorBrightGreen)
End Sub

Sub 着色する(ByRef 置換文字 As String, カラー As Long)
With ActiveDocument.Range(0, 0).Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = 置換文字
    .Replacement.Font.Color = カラー
    .Format = True
    .Forward = True
    .Wrap = wdFindContinue
    .MatchFuzzy = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    .Format = False
    .Font.Color = False
    .Replacement.Font.Color = False
    .Text = ""
    .MatchWildcards = False
End With
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

Sub 英字数字括弧いろかはれ()

Dim 英字ギリシャ文字 As String: 英字ギリシャ文字 = "[Ａ-Ｚａ-ｚA-Za-zΑ-Ωα-ω]"

Dim 数字 As String: 数字 = "[０-９0-9]"

Dim 括弧 As String: 括弧 = "[（*）]"

Call 着色する(英字ギリシャ文字, wdColorDarkRed)

Call 着色する(数字, wdColorAqua)

Call 着色する(括弧, wdColorBrightGreen)

End Sub

Sub 着色する(ByRef 置換文字 As String, カラー As Long)

With ActiveDocument.Range(0, 0).Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = 置換文字

.Replacement.Font.Color = カラー

.Format = True

.Forward = True

.Wrap = wdFindContinue

.MatchFuzzy = False

.MatchWildcards = True

.Execute Replace:=wdReplaceAll

.Format = False

.Font.Color = False

.Replacement.Font.Color = False

.Text = ""

.MatchWildcards = False

End With

End Sub

このマクロでは、英字ギリシャ文字が濃赤色（wdColorDark […]

公開済み: 2019年3月9日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

隅付き括弧と角括弧を入れ替えたいときに

たまに、段落番号の表示等で使う墨付き括弧’【】’を角括弧’[]’に変更するとき、または、その逆に変更するときがあります。そのようなとき、簡単に括弧の種類を変更できるマクロを作成しました。

Sub 括弧の種類を変えます()
Dim cur As Range
Dim objRng As Range
Set cur = Selection.Range
Set objRng = Selection.Range

'選択範囲がないとき全文を置換範囲にします
If cur.Start = cur.End Then
    objRng.Start = 0
    objRng.End = ActiveDocument.Bookmarks("\EndOfDoc").End
End If

If 語句あるかB("【", objRng) = True Or 語句あるかB("】", objRng) = True Then
    Call 範囲を指定して置き換えるB("【", "[", objRng)
    Call 範囲を指定して置き換えるB("】", "]", objRng)
Else
    Call 範囲を指定して置き換えるB("[", "【", objRng)
    Call 範囲を指定して置き換えるB("]", "】", objRng)
End If
cur.Select
Set objRng = Nothing
Set cur = Nothing
End Sub

Function 語句あるかB(ByRef 検索文字 As String, ByRef rng As Range) As Boolean
If Not rng Is Nothing Then rng.Select
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = 検索文字
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchFuzzy = False
    .MatchWildcards = False
    語句あるかB = .Execute
    
    .Text = ""
End With
End Function

Sub 範囲を指定して置き換えるB(ByRef 置換前 As String, ByRef 置換後 As String, ByRef rng As Range)
With rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = 置換前
    .Replacement.Text = 置換後
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = False
    .MatchFuzzy = True
    .Execute Replace:=wdReplaceAll
    
    .Text = ""
    .Replacement.Text = ""
    .MatchFuzzy = False
End With
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

Sub 括弧の種類を変えます()

Dim cur As Range

Dim objRng As Range

Set cur = Selection.Range

Set objRng = Selection.Range

'選択範囲がないとき全文を置換範囲にします

If cur.Start = cur.End Then

objRng.Start = 0

objRng.End = ActiveDocument.Bookmarks("\EndOfDoc").End

End If

If 語句あるかB("【", objRng) = True Or 語句あるかB("】", objRng) = True Then

Call 範囲を指定して置き換えるB("【", "[", objRng)

Call 範囲を指定して置き換えるB("】", "]", objRng)

Else

Call 範囲を指定して置き換えるB("[", "【", objRng)

Call 範囲を指定して置き換えるB("]", "】", objRng)

End If

cur.Select

Set objRng = Nothing

Set cur = Nothing

End Sub

Function 語句あるかB(ByRef 検索文字 As String, ByRef rng As Range) As Boolean

If Not rng Is Nothing Then rng.Select

With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = 検索文字

.Format = False

.Forward = True

.Wrap = wdFindStop

.MatchFuzzy = False

.MatchWildcards = False

語句あるかB = .Execute

.Text = ""

End With

End Function

Sub 範囲を指定して置き換えるB(ByRef 置換前 As String, ByRef 置換後 As String, ByRef rng As Range)

With rng.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = 置換前

.Replacement.Text = 置換後

.Format = False

.Forward = True

.Wrap = wdFindStop

.MatchWildcards = False

.MatchFuzzy = True

.Execute Replace:=wdReplaceAll

.Text = ""

.Replacement.Text = ""

.MatchFuzzy = False

End With

End Sub

上記のマクロでは、【】があるとき、【】→[ […]

公開済み: 2019年3月8日
更新: 2019年3月19日
作成者: アキノハ
カテゴリー: ワード

ショートカットキーでVBSを実行したいときに

折角VBScriptを使うのであれば、ショートカットキーに登録すれば、より利便性は高まります。そこで、VBScriptにショートカットキーを割り当てる手順をご紹介します。　まず、VBSファイルを右クリックし、[S]キーを押し、ショートカットファイルを作成します。続いて、ショートカットファイル […]

公開済み: 2019年3月7日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: VBS

キーワードをテレコにしたいときに

文を書き進めていくと、２つのキーワードをテレコにしたいときがあります。例えば「第１部材」を書いた後、説明の順番でどうしても「第１部材」の前に「第２部材」を書き入れたくなることがあります。そのまま書き入れると、「第１部材」の前に唐突に「第２部材」が登場してしまいます。 [crayon-60fb7f […]

公開済み: 2019年3月4日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

変更履歴の承諾とコメントの削除を一度に済ませたいときに

１回の実行で、変更履歴をすべて承諾し、コメントをすべて削除するマクロをご紹介します。

Sub 全文を承諾してコメントを削除する()
On Error Resume Next
With ActiveDocument
    .Revisions.AcceptAll
    If .Comments.Count > 0 Then .DeleteAllComments
End With
End Sub

1

2

3

4

5

6

7

Sub 全文を承諾してコメントを削除する()

On Error Resume Next

With ActiveDocument

.Revisions.AcceptAll

If .Comments.Count > 0 Then .DeleteAllComments

End With

End Sub

（参考）背景を白色に戻したいとき

公開済み: 2019年3月3日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

読点・カンマを整えたいときに

日本語入力にしてキーを叩くと読点「、」が入力され、英語入力にしてキーを叩くとカンマ「,」が入力されます。文を作成していると、読点を入力したいのにカンマを入力してしまったり、その逆があったり。

Sub カンマと読点()
Dim R As String
R = "([Ａ-Ｚａ-ｚA-Za-zΑ-Ωα-ω０-９0-9])"
Dim cur As Range
Set cur = Selection.Range
Call 置き換える(",", "、")
Call 置き換える("，", "、")
Call 置き換える(R & "、" & R, "\1，\2")
cur.Select
Set cur = Nothing
End Sub

Sub 置き換える(ByRef 置換前 As String, ByRef 置換後 As String)
With ActiveDocument.Range(0, 0).Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = 置換前
    .Replacement.Text = 置換後
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchFuzzy = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    .Text = ""
    .Replacement.Text = ""
End With
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

Sub カンマと読点()

Dim R As String

R = "([Ａ-Ｚａ-ｚA-Za-zΑ-Ωα-ω０-９0-9])"

Dim cur As Range

Set cur = Selection.Range

Call 置き換える(",", "、")

Call 置き換える("，", "、")

Call 置き換える(R & "、" & R, "\1，\2")

cur.Select

Set cur = Nothing

End Sub

Sub 置き換える(ByRef 置換前 As String, ByRef 置換後 As String)

With ActiveDocument.Range(0, 0).Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = 置換前

.Replacement.Text = 置換後

.Format = False

.Forward = True

.Wrap = wdFindContinue

.MatchFuzzy = False

.MatchWildcards = True

.Execute Replace:=wdReplaceAll

.Text = ""

.Replacement.Text = ""

End With

End Sub

このマクロでは、まず、すべてのカンマを読 […]

公開済み: 2019年2月28日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

マクロが勝手に消えないようにしたいときに

ワードの一般的な設定情報は、下記の「Normal.dotm」ファイルに記録されていますが、どうも不安定です。 C:\Users\%username%\AppData\Roaming\Microsoft\Templates\Normal.dotm これとは別に、拡張子「dotm」のマクロ専用ファイルを […]

公開済み: 2019年2月27日
更新: 2019年3月19日
作成者: アキノハ
カテゴリー: ワード

変更履歴だらけにしたくないときに

ワードの原稿に変更履歴で修正を入れることがあります。複数出てくる名称等は、変更履歴をオンにしてCtr+Hなどで一括置換すると便利です。しかしながら、一括置換も多用しすぎると、文書が変更履歴だらけになってしまいます。例えば、「制御装置」を「制御部」に変えるとき、「制御」はそのままで、「装置」だけ「 […]

公開済み: 2019年2月23日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード

マーキングをしたいときに

文書のチェックをしているときなど、一文を他とは違う色でマーキングしたいと思うことがあります。次のコードは、カーソル位置の文全体を赤色にマーキングします。

Sub マーキング赤()
Selection.Sentences(1).Font.Color = wdColorRed
End Sub

1

2

3

Sub マーキング赤()

Selection.Sentences(1).Font.Color = wdColorRed

End Sub

元の色に戻すコードは、次のとおりです。 [crayon-60fb7f2ae17 […]

公開済み: 2019年2月20日
更新: 2020年9月3日
作成者: アキノハ
カテゴリー: ワード