複数のExcelファイルに同じパスワードがセットされている場合に、それを一括して解除して保存するマクロです。
逆に一括してパスワードをセットすることもできます。
最初にダイアログでパターンを訊かれますので、解除ならば「はい」、セットならば「いいえ」を選択します。
次にダイアログでパスワードをセットします。
最後にファイルが保存されているフォルダを指定します。下位階層には対応していません。
「”\*.xls”」の部分を適宜、変更してください。
Excel2007で確認しました。
Sub 複数ファイルパスワード操作()
Dim myfolder, myfn, myword, pwopen, pwclose
Dim pattern
'操作を選択
pattern = MsgBox("パスワード解除ならば「はい」、セットならば「いいえ」", vbYesNo)
If pattern = vbCancel Then
Exit Sub
End If
'パスワードをセット
myword = InputBox("パスワードを入力。")
If pattern = vbYes Then
pwopen = myword
pwclose = ""
ElseIf pattern = vbNo Then
pwopen = ""
pwclose = myword
End If
'フォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "解除したいファイルのあるフォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
myfolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
'ファイルを操作
myfn = Dir(myfolder & "\*.xls", vbNormal)
Do Until myfn = ""
Call ファイル開閉(myfn, pwopen, pwclose)
myfn = Dir
Loop
End Sub
Function ファイル開閉(myfn, pwopen, pwclose)
Workbooks.Open Filename:=myfn, Password:=pwopen
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=myfn, Password:=pwclose, WriteResPassword:=""
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Function
ExcelのVBAで半角を全角に変換するのはとても簡単です。
「StrConv」を使うといろいろな変換ができます。
引数に「vbWide」を指定すると半角を全角に変換します。
使用例は次の通りです。
Function han2zen(t)
han2zen = StrConv(t, vbWide)
End Function
次は半角カタカナを全角に変換する方法です。
カタカナは全角に変換するが、英数字は半角のままにしたい、というようなケースに使います。
Function han2zen_kana(t)
Dim u, v As String
Dim i As Long
u = StrConv(t, vbWide)
For i = 1 To Len(u)
If Mid(u, i, 1) Like "[!ァ-ヶー]" Then
v = v & StrConv(Mid(u, i, 1), vbNarrow)
Else
v = v & Mid(u, i, 1)
End If
Next i
han2zen_kana = v
End Function
「Like」を使っています。
これはVBAでワイルドカードを使う場合に用いられます。
You Look Too Cool » VBAでワイルドカードを使う
「Like “[!ァ-ヶー]“」とすることで全角カタカナ以外の場合のみを取り出すことができます。
上の例では全角カタカナ以外の場合のみ半角に変換しています。
VBAでは「Like」を使ってワイルドカード的な使い方ができます。
If myword Like "[a-z]" Then
使い方は次の通りです。
【構文】
文字列がパターンに合致するとTrueを返します。
【パターン】
| 文字パターン |
引数stringの中の一致する文字 |
| ? |
任意の1文字 |
| * |
任意の数の文字 |
| # |
任意の1文字の数字(0-9) |
| [charlist] |
文字リストcharlistに指定した文字の中の任意の1文字 |
| [!charlist] |
文字リストcharlistに指定した文字以外の任意の1文字 |
次にパターンに文字リストを使う場合の例を示します。
半角カタカナ
半角カタカナはコード順で「ｦｧｨｩ…ﾚﾛﾜﾝ」と並ぶので「[ｦ-ﾝ]」とします。
全角カタカナ
全角カタカナはコード順で「ァアィイ…ンヴヵヶ」と並ぶので「[ァ-ヶ]」とします。
ただし長音が含まれないので、これを含めるため「[ァ-ヶー]」とします。
全角ひらがな
全角ひらがなはコード順で「ぁあぃい…ゐゑをん」と並ぶので「[ぁ-ん]」とします。
ただし長音が含まれないので、これを含めるため「[ぁ-んー]」とします。
半角英小文字
半角英大文字
半角数字
「[0-9]」としてもよいのですが半角数字に関しては上述の通り「#」という記号が用意されています。
段組みを使ったWord文書を段組みの情報を残したままテキストで出力する方法です。
1段の場合は40文字、2段の場合は19文字で改行を挿入します。
段組みの段数は「段落.PageSetup.TextColumns.Count」で取得できます。
またセクション区切りの部分(文字コードが12)はそのまま出力すると表示がおかしくなるので判定して無視します。
関数「cut」は文字列に指定した文字数で改行を挿入します。
Sub 段組みをテキスト出力()
'段数に応じて改行を追加しテキストファイルに出力する。
Const mojisu1 = 40 '段数が1のとき
Const mojisu2 = 19 '段数が2のとき
Const myfilename = "d:\test.txt"
Dim danrakusu, dansu, mojisu, i
Dim danraku
Dim mytext
'各段落の文字列と段数を取得し、段数に応じて改行を追加する。
danrakusu = ActiveDocument.Paragraphs.Count
mytext = ""
For i = 1 To danrakusu
danraku = ActiveDocument.Paragraphs(i)
dansu = danraku.PageSetup.TextColumns.Count
If (Asc(danraku) <> 12) Then
If dansu = 1 Then
mojisu = mojisu1
Else
mojisu = mojisu2
End If
mytext = mytext & cut(danraku, mojisu)
End If
Next i
'文字列をテキストファイルに出力する。
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.WriteText mytext, 1
.SaveToFile myfilename, 2
.Close
End With
End Sub
Function cut(str, num)
Dim i
For i = 1 To Len(str)
cut = cut & Mid(str, i, 1)
If i Mod num = 0 Then
cut = cut & Chr(13)
End If
Next i
End Function
Windowsにはファイルの内容を検索する機能があります。
しかしExcelを検索する場合、どのファイルにあるかは表示されますが、どのシートにあるかは表示されません。
シートが多いと、そのファイルを開いてから、また検索する必要があります。
そこで、ある文字列について、特定のフォルダにある、すべてのExcelファイルのすべてのシートを検索し、どのシートにあるかを表示するマクロを考えました。
検索結果を表示するだけでなく、該当のセルにハイパーリンクを張るようになっています。
Excel2007で確認しました。 続きを読む…
ある日からその日を含んでX日を経過した日をExcelで求めるには「始期となる日+X-1」とすればOKです。
では日曜日を含まないで計算するにはどうしたらよいでしょうか。
たとえば2011年12月8日(木)の7日経過した日は単純に計算すると14日(水)になります。
しかし日曜日を含まない場合、8日(木)の7日経過した日は15日(木)になります。
「木、金、土、月、火、水、木」と日曜日をとばすからです。
この日曜日をとばすという処理が面倒です。 続きを読む…
Excelで罫線を使って表を作る場合は多いです。
一つのシートに複数の表を縦に作っていく場合、表の途中で改ページされると困ることがあります。
そこであらかじめ、それぞれの表の下端で改ページしておく、という方法が考えられます。
これを自動的に実行するマクロを作りました。 続きを読む…
Wordのマクロでワイルドカードを使って検索、置換をしようとしたところエラーが出ました。
Sub replace_test()
With Selection.Find
.Text = "あけまして*ございます"
.Replacement.Text = ""
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
エラーメッセージは次の通り。
MatchPhrase、MatchWildcards、MatchSoundsLike、MatchAllWordForms、MatchFuzzyパラメータは、同時にTrueに設定することができません。
Wordで検索、置換をするときはいろいろなオプションがあります。
文書を直に検索、置換するときは矛盾するオプションは選べないようになっていますが、マクロで使うときには正しく設定しないとエラーになります。
例えば、ワイルドカード検索とあいまい検索はどちらが優先するのか、はっきりしないのでエラーになるようです。
ところで、ここで登場した5個のオプションの意味は次の通りです。どれもTrueかFalseを設定します。
| MatchPhrase |
単語間のすべての空白文字および制御文字が無視されます。 |
| MatchWildcards |
検索する文字列にワイルドカードが含まれている場合、このプロパティの値は True です。 |
| MatchSoundsLike |
True に設定すると、検索文字列に類似した単語が検索対象となります。 |
| MatchAllWordForms |
True に設定すると、検索文字列のすべての活用形が検索対象となります。 |
| MatchFuzzy |
True に設定すると、検索時に日本語の文字列のあいまい検索オプションが使用されます。 |
そこで、MatchWildcardsだけにTrueをセットし、その他はFalseをセットしました。
Sub replace_test()
With Selection.Find
.Text = "あけまして*ございます"
.Replacement.Text = ""
.MatchPhrase = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
しかしこれでも同じエラーが出ます。
セットする順序が影響するようです。
Sub replace_test()
With Selection.Find
.Text = "あけまして*ございます"
.Replacement.Text = ""
.MatchPhrase = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
順序を変えてMatchWildcardsを最後にしてみたところ正しく動作しました。
VBAのユーザー定義関数で引数の数が一定でない場合があります。
このケースでは、a、b、cが引数です。引数の数は3個です。
Function kansu(a, b, c, d)
このケースでは、a、b、c、dが引数です。引数の数は4個です。
このように、場合によって引数の数が違う場合のユーザー定義関数の作り方を示します。 続きを読む…
Word文書を開いたときに自動的にマクロを実行する方法です。
ここでは文書を開いたときに「Hello!」というメッセージボックスを表示させます。 続きを読む…
最近のコメント