好きなものあれこれ

今回はWord2000/2003の標準ツールバーにアイコンを追加しようとしたときの不具合を発見したので
紹介したいと思います。

そのアイコンとは、タイトルの通り「文字種の変換」です。
私は比較的頻繁に全角、半角、大文字、小文字の変換をするので、メニューから「文字種の変換」を
呼び出すのが面倒なので、[ユーザ設定]の[コマンド]タブに隠れているアイコンを

ツールバーに追加しました。



が、クリックしても変換してくれません。

しかたがないので、カスタムツールバーにVBAでアイコンを登録しました。
でも、これの方が便利かも。


Sub 大文字に変換()
    Selection.Range.Case = wdUpperCase
   
End Sub
Sub 小文字に変換()
    Selection.Range.Case = wdLowerCase

End Sub
Sub 全角に変換()
    Selection.Range.CharacterWidth = wdWidthFullWidth
   
End Sub
Sub 半角に変換()
    Selection.Range.CharacterWidth = wdWidthHalfWidth
   
End Sub

これってバグですよねMicrosoftさん？

今回は、前回、前々回でツール用.docを作成している中で作成したユーザ設定ツールバー（以降、カスタムツールバー）についてあれこれ書いてみたいと思います。
Excelのカスタムツールバーとだいぶ勝手が違うのと、これはWordのバグでは？と思うところがあります。

事象１．
まず、Word2000/2003のカスタムツールバーでは、マクロボタンを追加すると
Project.モジュール名.プロシージャ名という名前がデフォルトで設定されますね。
これを別の日本語名に変更したとすると、名前は日本語名になりますが、ツールチップ（ポップアップヒント）は変更前のプロシージャ名のままです。（私だけじゃないですよね？）
Excelではこうはなりません。

事象２．
さらに、マクロボタンにはショートカットキーを登録できますが、ショートカットキーを名前やツールチップに表示することができません。どうも、カスタムツールバー上の右クリック[ユーザー設定]-[オプション]タブ-[ボタン名と一緒にショートカットキーを表示する]をチェックするとできそうな雰囲気があるのですが、これをチェックしても何も起こりません。

ExcelではOnkeyメソッドで登録しておくときちんと表示してくれます。
しかたないので、事象１、２を解消するために以下のとおり、AutoOpen()に、ツールチップを名前に置き換える処理を組み込んでいます。

'カスタムツールバーのツールチップ設定
Private Sub SetMyToolBar()
    Dim myBar As CommandBar
    Dim lKeyString As String
    For Each myBar In Application.CommandBars
        If myBar.Name = cMyBarName Then
            For Each oCbt In myBar.Controls
                lKeyString = GetKeyString("Project." & oCbt.OnAction)
                If lKeyString = "" And (oCbt.Caption Like "*+*") Then
                    oCbt.Caption = Left(oCbt.Caption, InStrRev(oCbt.Caption, " ") - 1)
                ElseIf Not (oCbt.Caption Like "*" & lKeyString & "*") Then
                    oCbt.Caption = oCbt.Caption & " " & lKeyString
                End If
                oCbt.TooltipText = oCbt.Caption
            Next
            Exit For
        End If
    Next
    Set oCbt = Nothing
    Set myBar = Nothing
End Sub

事象３．
ショートカットキーではほかにも厄介な点があります。前回にも触れましたが「マクロの隠蔽」です。
Excelでは、マクロボタンを作成したあと隠蔽するためにPrivateに変更するのですが、これをWordでやると、
マクロをクリックして実行するには問題ありませんが、ショートカットキーが無効になってしまいます。
どうにかしてくれ、Microsoftさん！


事象４．
次に、カスタムツールバーにマクロボタンを追加した後にモジュール名を変更すると、


『マクロが見つからないか、またはマクロに対するセキュリティ レベルが高く設定されているためマクロが無効にされています。』

というエラーが発生するようになります。始めは理由が分からずカスタムツールバーのボタンを再作成したりしていました。
ま、これはなんとなくうなずけます。デフォルトでProject.モジュール名.プロシージャ名という名前が割り当てられるという辺りから、ボタンとプロシージャの関連付けはモジュール名も関係しているということなのでしょう。
しかし、これもExcelではこうはなりません。

これらはどう考えてもバグではないですかね、Microsoftさん！
Word2007は使ったことが無いので解消されているのかもしれませんが、Excelと比べるとどうにも厄介です。。。

「ツールの構成と配布方法について」のその２です。

前回の続きとして、
想定する動作環境
(1)Normal.dotは汚したくないのでマクロは記述しない
(2)E2000Tools.xlsのようにツール用.docにマクロを集約したい、これを配布したい
(3)ツール用.docにカスタムツールバーを作成し、全ドキュメントで共有したい
(4)ツール用.docはスタートアップで自動起動したい
(5)ツール用.docは非表示にしたい
(6)全ドキュメントに対して動作するマクロを記述したい
の実現を目指し、(1)～(5)まで達成できました。
今回は(6)について検討してみたいと思います。

ここでちょっと比較ですが、Excel VBAでは、
ツール用.xlsの
(1)VBEのクラスモジュールで、モジュール名XXXを新規作成します（例；class1）
(2)このクラスモジュールに全ブックに対する処理を記述しておきます（例：Sub App_WindowActivate）
(3)Thisworkbookモジュールにworkbook_openプロシージャを作成し、クラスとApplicationオブジェクトを関連付けます
これで、ツール用.xlsが起動した段階でクラスモジュールの設定が完了し、その後、全ブックがActiveになった時にApp_WindowActivateプロシージャが起動されるようになります。
詳細を知りたい方は、ヘルプで”Application オブジェクトでイベントを使用する”を検索してみてください。

この要領でいけば、Word VBAでは、
ツール用.docの
(1)VBEのクラスモジュールで、モジュール名XXXを新規作成します（例；class1）
(2)このクラスモジュールに全Docに対する処理を記述しておきます（例：Sub App_DocumentOpen）
(3)ThisDocumentモジュールにDocument_openプロシージャを作成し、クラスとApplicationオブジェクトを関連付けます
これでうまくいくと思いきや、残念ながらそうはいきません。

問題の本質は、ドキュメントやテンプレートの起動時に実行すべき(3)の処理であるDocument_openは、Docでは起動されますが、アドインテンプレート（.Dot）では起動しないということです。
これを解消するには、自動実行マクロ関数を用います。
ヘルプによると
    ・Docで起動されるのは、AutoOpen,AutoClose
    ・アドインで起動されるのは、AutoExec,AutoExit
ということで、Docとアドインでは起動されるプロシージャが違うので、同じ処理をそれぞれに記述する必要がありそうです。
さらに、マクロを隠蔽することがわたしの望むところなのですが、残念なことに自動実行マクロではそれができません。
マクロの隠蔽とは、プロシージャを”マクロの実行”ダイアログに表示しないようにすることを意味します。具体的には、PrivateやSub xxxxx(Optional Dummy)とするのですが、これをすると自動実行マクロは起動されなくなるので、Publicが必須となります。
とはいえ、なんとか自動実行マクロにすることで(6)が実現できました。

次回は、その１、その２を実現する中で、Wordの不具合と思われる事象が発見されたのでそれについて記述したいと思います。

滅多にないWord VBAネタです。
最近Wordを使う機会が増えたので、これを機にWord VBAで本格的にツールを作成しようと考えたのですが、Excel VBAと同じと思いきや結構違いがあるのですね。
自作ツールのE2000Toolsのように、ツールを他人に配布することを前提に、ツールの構成や動作環境を構築するにはどうすればよいか試行錯誤しました。私なりに理解した範囲で以下にまとめてみます。

まずは基本中の基本
ネットではテンプレートとアドインという言葉がそれぞれ使われていてどう違うのか良く分かりませんでしたが、このサイトがその点をまとめられていてとても分かりやすかったです。テンプレートという考え方が理解できました。

想定する動作環境
(1)Normal.dotは汚したくないのでマクロは記述しない
(2)E2000Tools.xlsのようにツール用.docにマクロを集約したい、これを配布したい
(3)ツール用.docにカスタムツールバーを作成し、全ドキュメントで共有したい
(4)ツール用.docはスタートアップで自動起動したい
(5)ツール用.docは非表示にしたい
(6)全ドキュメントに対して動作するマクロを記述したい

結論（運用確立！）
いやぁ苦労しました。試行錯誤してやっと以下の運用に辿り着きました。

まずツール用.docにマクロを記述し、作成したカスタムツールバーから起動できるようにします。
でも、このままでは、ツール用.docを起動しておいたとしても他のドキュメントからこのマクロやツールバーは利用できません。しかもツール用.docは前述(5)の非表示が実現できません。
さらに、ツール用.docを、後述するSTARTUPフォルダから起動すると、

　　『プロジェクトを表示できません。』

といわれてしまってマクロの編集が行えない状態となります。なんとも開発しづらい。
なので、

　　> copy ツール用.doc ツール用.dot /y

を実行して、アドインテンプレート”ツール用.dot”を作成する運用にします。
実際には、上記コマンドをバッチファイルで実行していますが。。。
普段はツール用.dotを使用して、何かマクロを追加したいときや、不具合を発見したときは、ツール用.docで対応し、動作確認できたらツール用.dotを作成します。
こうすることで、ツール用.doc（＝開発用）とツール用.dot（＝配布用）の役割が明確になりました。

Word起動と同時に常に使用するためには以下のフォルダにツール用.dotを格納します。
　　C:\Documents and Settings\ユーザ名\Application Data\Microsoft\Word\STARTUP
ここまでで、前述の動作環境(1)～(5)までが達成されました。
(6)が残りました。これがまた厄介なので次回に記述したいと思います。

Excel情報を読み込んでメールを自動送信する方法 その２を書いてみたいと思います。
送信情報を管理するＥｘｃｅｌ側と実際に送信するOutlook VBAです。

■Excel側
こんな感じにしてみました


■OutlookVBA側
moduleに以下のソースを貼り付けて実行してみましょう。
（１）メールの送信タイミングになるとこのダイアログを出します
 

（２）”はい”であれば処理を継続し、添付ファイル有無＝”有”であればこのダイアログを出します
添付したいファイルを複数選択します
 

（３）送信フォルダに人数分のメールが作成されます



解説ですが、自動送信管理.xlsを読み込み、セルの情報を取得します。
自動送信管理.xlsには複数シート定義する前提で全てのシート分繰返し処理します。
各シートの次回送信予定日と当日を比較して送信タイミングであれば処理を続行します。
以下のソースではわざと条件をひっくり返して必ず実行するようにしています。
添付ファイル有無＝”有”の場合はファイル選択ダイアログを表示します
自動送信管理.xlsのメール情報に基づき、宛先分の送信メールを送信フォルダに格納していきます。
ここまでがソースの機能です。あとはoutlook起動時に”メール自動送信”を実行するように設定すればOKです。定義の仕方は、◆Excel VBA（ファイル起動と同時にマクロを実行）を参考にしてみてください。

Sub メール自動送信()
    Const XlsPath As String = "c:\outlook\自動送信管理.xls"
    Dim rtn As Boolean
   
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.MailItem

    Dim myCopiedItem As Object
    Dim myAttachments As Object
    Dim myNameSpace As Object
    Dim mySendFolder As Object
   
    Dim MsgTxt As String
    Dim a As String, b As String, c As String, d As String, e As String, f As String, g As String, h As String, q As String
    Dim l As String, m As String, n As String, o As String
    Dim Files As Variant, oF As Variant
    Dim myExlApp As Object, oNewWb As Object, oSel As Object
    Dim i As Integer, j As Integer
    Dim lMax As Long, lRow As Long, lColMax As Integer
    Dim lSubject As String
   
    'On Error GoTo p_Error
   
    '現在のｳｨﾝﾄﾞｳﾀｲﾄﾙ取得
    Dim Leng As Long, hWnd As Long, ret As Long, MyTitle As String
    hWnd = GetActiveWindow()
    MyTitle = String(250, Chr(10))
    Leng = Len(MyTitle)
    ret = GetWindowText(hWnd, MyTitle, Leng)
       
    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlExp = myOlApp.ActiveExplorer
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set mySendFolder = myNameSpace.GetDefaultFolder(olFolderOutbox)     '送信トレイ
   
    'ﾌﾞｯｸ読み込み
    Set myExlApp = CreateObject("excel.Application")
    Set oNewWb = myExlApp.workbooks.Open(FileName:=XlsPath, ReadOnly:=False)
   
    Const cTitle As String = "C2"
    Const cHonbun As String = "C3"
    Const cKenshuNm As String = "C4"
    Const cEndDay As String = "C5"
    Const cSendMax As String = "C6"
    Const cSendSu As String = "C7"
    Const cSend As String = "C8"
    Const cNextDay As String = "C9"
    Const cTempFile As String = "C10"
    Const cName As Integer = 2
    Const cId As Integer = 4
    Const cTo As Integer = 3
    Const cCC As Integer = 5
    Const cKbn As Integer = 6
    Dim oWs
    Const cStRow As Integer = 13
   
    For Each oWs In oNewWb.worksheets
        If oWs.Name Like "■*" Then GoTo next_oWs
       
        a = oWs.Range(cTitle).Value
        b = oWs.Range(cHonbun).Value
        c = oWs.Range(cKenshuNm).Value
        d = oWs.Range(cEndDay).Value
        e = oWs.Range(cSendMax).Value
        f = oWs.Range(cSendSu).Value
        g = oWs.Range(cSend).Value
        h = oWs.Range(cNextDay).Value
        q = oWs.Range(cTempFile).Value
       
        If h <> "終了" And Format(h, "yyyymmdd") >= Format(Now(), "yyyymmdd") Then
'        If h <> "終了" And Format(h, "yyyymmdd") <= Format(Now(), "yyyymmdd") Then
            If vbNo = MsgBox("===========================================================================" & vbCrLf & vbCrLf & _
                                "  " & oWs.Name & "は【第" & f + 1 & "回】目の送信日になりました。" & vbCrLf & _
                                "  送信フォルダにメールを準備しますか？" & vbCrLf & vbCrLf & _
                             "===========================================================================" _
                             , vbQuestion + vbYesNo, "☆☆☆ 自動送信確認 ☆☆☆") Then GoTo next_oWs
        Else
            GoTo next_oWs
        End If
            
        '添付ファイル有無
        myExlApp.Visible = True
        If q Like "*有*" Then
            Files = myExlApp.GetOpenFilename("ﾌｧｲﾙ(*.*),*.*", , "--- 添付するﾌｧｲﾙを選択してください ---", "選択", True)
            If IsArray(Files) <> True Then
                q = "無"
                oWs.Range(cTempFile).Value = "無"
            End If
        End If
        myExlApp.Visible = False
       
        '受講者分送信メール作成
        lMax = oWs.cells(65500, 2).End(-4162).row
        lColMax = oWs.cells(cStRow - 1, 255).End(-4159).column + 1
        For lRow = cStRow To lMax
            If oWs.cells(lRow, cTo).Value <> "" And oWs.cells(lRow, cKbn).Value = "" Then
                l = oWs.cells(lRow, cName).Value
                m = oWs.cells(lRow, cId).Value
                n = oWs.cells(lRow, cTo).Value
                o = oWs.cells(lRow, cCC).Value
               
                'メール送信
                lSubject = c & " (" & lRow - cStRow + 1 & "/" & lMax - cStRow + 1 & ")"
                ret = SetWindowText(hWnd, lSubject & "を処理中...")
                Set myCopiedItem = Application.CreateItem(0)
                myCopiedItem.Subject = "【第" & f + 1 & "回】" & a
                myCopiedItem.Importance = olImportanceHigh
                myCopiedItem.Body = l & b
                myCopiedItem.To = n
                myCopiedItem.CC = o
                myCopiedItem.BCC = "bcc@hogehoge.co.jp"
               
                '添付ﾌｧｲﾙを貼り付ける
                If q Like "*有*" Then
                    For j = 1 To UBound(Files)
                        Set myAttachments = myCopiedItem.Attachments
                        myAttachments.Add Files(j), olByValue, 9999, Mid(Files(j), InStrRev(Files(j), "\") + 1)
                    Next
                End If
               
                '送信ﾄﾚｲに移動
                myCopiedItem.Save
                myCopiedItem.Move mySendFolder
               
               
                '送信実績設定
                oWs.cells(cStRow - 1, lColMax).Value = Format(Now(), "yyyy/mm/dd")
                oWs.cells(lRow, lColMax).Value = myExlApp.Application.username
               
            End If
        Next
       
        '送信実施回数更新
        oWs.Range(cSendSu).Value = oWs.Range(cSendSu).Value + 1
       
next_oWs:
    Next
   
   
p_Error:
    'ファイルクローズ
    oNewWb.Close SaveChanges:=True
   
    Set oF = Nothing
    Set oSel = Nothing
    Set myExlApp = Nothing
    Set oNewWb = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
    Set myCopiedItem = Nothing
    Set myAttachments = Nothing
    ret = SetWindowText(hWnd, MyTitle)
End Sub

久しぶりのVBAネタです。
それもOutlookです。
仕事で１ヶ月に１度くらいの頻度で自動的にメールを送信したいという要望が出ました。送信要件が複数あり、送信タイミングもばらばらといった具合です。
そこで予めExcelにその情報を設定しておいて、マクロで毎日送信タイミングを確認すればよいと考えました。
以下がその仕様です。
■Excel側
送信要件毎にシートを分け、そのシートには、
   ・メールタイトル（送信要件）
   ・メール本文
   ・次回送信予定日
   ・添付ファイル有無
   ・送信者名（複数）
   ・送信者アドレス（複数）
   ・CCアドレス（複数）
   ・BCCアドレス（複数）
といった情報を持たせます

■OutlookVBA側
以前、◆Excel VBA（ファイル起動と同時にマクロを実行）で書いたPrivate Sub Application_Startup()にマクロを登録しておきます。これでOutlook起動時に実行してくれます。
そのマクロの処理ですが、以下の流れでいきます。
（１）Excelブックを読み込み
　　　　　↓
（２）全てのシート（送信要件）に対して次回送信予定日＜＝今日であれば
　　　　　↓
（３）送信者アドレス（複数）分のメールを新規作成して
タイトル、本文、To、Cc、Bcc、添付ファイルなどを設定して送信フォルダに格納する
　　　　　↓
（４）以前書いた◆Outlook VBA（Outlookのカスタマイズと配布方法）にある
"選択メールを一括送信"で一括送信する

いきなり送信は厳しいので送信フォルダにメールを作成し、確認したうえで
送信したいメールを選択した状態で一括送信マクロを実行するという構想です
（１）は以前書いた◆Outlook VBA（Outlookメール情報をExcel一覧化）を応用すれば
すぐに出来そうです。（４）は既に出来ているので実質（３）までを新規作成すればよいわけです。

ではマクロを作成してみましょう。
と、大分長くなりましたので実際の処理は次回その２に公開します。
それではまた。

久しぶりのExcelネタです。
ファイルサイズは１MBくらいの大して大きくもないExcelのブックがあるのですが、起動するのに１、２分も掛かっていました。
確かに、行数は多いのですが列数はそれほどでもありません。ただ、セルの結合を多用していたので、もしかしたらと思い、セル結合を解除したら起動時間が２、３秒に改善されました。
起動が遅いブックがあったら、参考にしてみてください。
ちなみに私はセル結合が大嫌いなので滅多に使用しません。このブックは他人が作成したブックでした

久しぶりのExcelVBA（？）ネタです。Excelのソートってキー指定が最大３列までというのはご存知ですね。４列以上でソートしたくても指定できません。当然VBAのSortメソッドもこの制限があります。巷では何回かに分けてソートしなさいというような説明を見かけますが私はこれが理解できませんので試したことがありません。そもそも面倒です。今回は、私が普段使っている、もっと簡単確実でVBAに限らずExcel上でも普通に使用できる方法をご紹介します。
早い話、あるセルに、ソートしたい列順に結合した値を作成しておくというだけの事です。
例えば、下記の例で行くと、E列>C列>A列>B列>D列の順にソートしたいのであれば、F列に=E101 & C101 & A101 & B101 &D101といった式を設定して、F列でソートすればよいのです。
　    A　B　C　D　E　F
101 　1　2　3　4　5　=E101 & C101 & A101 & B101 &D101
101 　2　3　4　5　6　=E101 & C101 & A101 & B101 &D101
102 　3　4　5　6　7　=E102 & C102 & A102 & B102 &D102
103 　4　5　6　7　8　=E103 & C103 & A103 & B103 &D103

VBAマクロでは、例えば
For i=100 to 103
Cells(i,6).Value = Cells(i,5).Value & _
                          Cells(i,3).Value & _
                          Cells(i,1).Value & _
                          Cells(i,2).Value & _
                          Cells(i,4).Value
Next

Selection.Sort Key1:=Columns(6), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin

このようにすれば、ソートキーはいくらでも構わないわけです。お試しあれ。

久しぶりのE2000Toolsネタです。最近判明したのですが、当ブログで紹介していたE2000Toolsでエラーが発生するケースがあるそうです。Excel2003で使用している場合、E2000Toolsを起動するとエラーが発生する場合があります。この原因はOffice2003 SP3が導入されていないPCで発生するようです。もしもE2000Toolsをご利用の皆さんはご参考になさってください。

Accessネタは２回目です。皆さんはAccess VBAでモジュールやフォーム、クエリなどを修正する際に、誰かがアクセスしていて変更できなかったことはありませんか。Accessをネットワーク上で共有する際の運用方法にも関係しますが、フォームなどのアプリケーション部分とデータ部を切り離せば誰かがアクセスしていてもアプリの変更が可能になります。今回はその方法をご紹介します。ネットを”データベースを分割”、”分離”、”データベース分割ツール”といったキーワードで検索するとたくさん情報がありますが、意外と知られていない気がします。
以下はその設定方法と私の運用例を記します。
■設定方法
メニュー「ツール」→「データベースユーティリティ」→「データベース分割ツール」→「データベースの分割」→「バックエンドデータベースの作成」で保存先とファイル名を指定し、「分割」でmdbファイルが作成されます。
既存のA.mdb（アプリケーション部分）とA_be.mdb（データ部分）となり、A.mdbにはその時点で作成していた
　　・クエリ
　　・フォーム
　　・レポート
　　・マクロ
　　・モジュール
といったアプリケーション部分が格納されます。
さらに、テーブルに変わりテーブルへのAccessリンクが設定されます。
そしてA_be.mdbには実テーブルが格納されます。

■運用例
利用者に開放するmdbを本番DBとすると、テスト用DBが必要になります。そこで以下のように運用しています。
＜本番用DB＞
A.mdb ・・・・・ネットワーク上の公開し、利用者がPCにダウンロードして使用
A_be.mdb・・・・ネットワーク上の公開し共有

＜開発用DB＞
B.mdb ・・・・・フォームやモジュールを開発／テストし、A.mdbに上書き更新
B_be.mdb・・・・A.mdbを開発用にコピーし、ネットワーク上に格納。非公開

ここで注意が必要ですが、B.mdbがリンクしているバックエンドデータベースはB_be.mdbなので、そのままA.mdbに上書きするとA.mdbが開発用のB_be.mdbを参照することになってしまいますので、リンク先データベースを切り替える必要があります。
一般的な方法かどうかは分かりませんがオブジェクト「テーブル」で右クリックし、「テーブルのリンク」でA_be.mdbの各テーブルへのリンクを作成し、B_be.mdbへのリンクを削除し、リンク名を変更するといった面倒くさい手順になると思われます。テーブル数が多いととてもじゃないですが手作業は無理ですね。リンク先を容易に変更する機能が見当たらなかったので下記の通り自分で作成しました。この機能はB.mdbに実装しておくと便利になります。

Sub m_ChangeLink()
    Dim MyDb
   
    rtn = InputBox("リンク先を指定してください", "リンク切り替え", "c:\hogehoge_be.mdb")
    If rtn = "" Then Exit Sub
   
    Set MyDb = CurrentDb
    For Each oTb In dbs.TableDefs
'        MsgBox oTb.Name & " , " & oTb.connect
        If Not (oTb.Name Like "MSys*") Then
            oTb.connect = ";DATABASE=" & rtn & ";TABLE=" & oTb.Name
            oTb.RefreshLink
        End If
    Next
    Set MyDb = Nothing
    Set oTb = Nothing
End Sub

InputBoxでリンク先mdbをフルパスで指定します。For Each oTb In dbs.TableDefsで存在するテーブルリンク分処理を繰返し、リンク先を変更し、RefreshLinkで切替えます。参考にしてみてください。

久しぶりのExcel VBAネタです。以前AccessのデータをExcelに表示させる方法(http://peiyorin.cocolog-nifty.com/blog/2007/06/access_vbaacces_c97e.html)をご紹介しましたが、今回はODBC接続したRDBMS（データベース）の指定したテーブルの任意のカラムデータを取得する方法をご紹介いたします。
今回も仕事の関係で、簡単に試験の証跡をExcelで残したいという要望に答えたものです。仕事ではOracleを使用しているのですが、たまたまSQL Serverもあったのでこちらも取得できるようにしてみました。
まず、当ツールを使用するに当たりODBCドライバのインストールおよびデータセット名の設定が必要です。これについては詳しくは書きませんが、この辺りを理解していることが前提になります。データセット名の設定には、Oracleへの接続情報（ログインIDやパスワード、DBサーバのIPアドレスなど）やSQL Serverへの接続情報（SQL Serverのコンピュータ名やログインID、パスワードなど）が必要にありますのでネットワーク管理者やデータベース管理者から情報を入手してください。
次に、Excel VBA側ですが、以下の仕様で作成するものとします。
■仕様 ODBC接続ツール画像
（１）「条件」シートに以下の情報を定義します。
テーブル名：
カラム日本語名：
カラム名：
Where句：
（２）取得対象テーブルの「取得」欄に”●”を設定するものとします
（３）「取得」ボタンをクリックすると、マクロは取得欄が”●”のテーブルのデータを新規ブックにテーブル名シートを作成して張り付けることとします。

使い方の詳細は使い方シートや条件シートの吹き出しコメントをご覧ください。ツールをアップロードしておきますので、こちら から右クリックしてダウンロードしてご使用ください。

今回は、ブックとマクロを分離する方法をご紹介いたします。
通常、ブックにマクロを組み込んで配布してしまいがちですが、予め配布するブックとそれを操作するマクロを分離しておくと、不具合などが発生した場合はそのマクロだけ修正すれば再配布を最小限にすることができます。なぜ最小限かというと、ブック側の行や列を追加するといったレイアウトの変更の場合はブックの再配布が避けられないからです。
では、その方法ですが、ブック側とマクロ側に分けて解説します。

■ブック側
マクロ側にロジックを分離するといっても、ブック側に処理がなくなるわけではなく、マクロ側の処理を呼び出す命令を記述しなければなりません。
例えば、ボタンを配置して、そのボタンの処理を下記のように記述しておきます。
コンスタントの内容はシート上に定義しておくのも良いでしょう。

Const cMacroName As String = "【macro】.xls"
Const cMacroPath As String = "Q:\tool\" & cMacroName

Sub ボタン1()
    Workbooks.Open cMacroPath, ReadOnly:=True
    Application.Run (cMacroName & "!Button1_Click")

End Sub

Sub ボタン2()
    Workbooks.Open cMacroPath, ReadOnly:=True
    Application.Run (cMacroName & "!Button2_Click")

End Sub

■マクロ側（【macro】.xls)
下記例のように実際のロジックを記述します。
ブック側からオープンされるので、【macro】.xlsは非表示ブックにしておくと見た目がすっきりするでしょう。
ブック側を大勢のユーザに配布しても、このマクロ側の処理を変更するだけで即座に仕様変更等に対応できるという訳です。

Sub Button1_Click()

    Show.Dialog1

End Sub

Sub Button2_Click()

    Show.Dialog2

End Sub

マクロ側を普通の.xlsファイルとしていますが、アドインファイルにするという方法もありますが、機会があればご紹介いたします。

今回はマクロ側からVisual Basic Editorを操作する方法を書いてみたいと思います。

職場でVBAマクロのツールを作成していたりすると、始めは良いのですがそのうち機能追加や仕様変更などが発生して、マクロを修正することがあります。ブックにマクロを実装して複数の人に配布していると、下手をするとマクロの修正が発生するたびに、配布済みの大量のブックを直接修正する羽目になります。新しいブックを再配布して、利用者にシートを入れ替えてもらうといった手間を強いるケースも考えられます。
以上を考慮すると、予め複数の人が使用することが分かっている場合はブックとマクロを分離しておくことが望ましいです。分離する方法は次回述べますが、今回は既に多くの人に配布してしまったブックのマクロを置き換える方法をご紹介いたします。

■前提／作業の流れ
（１）まず、マクロが実装されているブックを多くの人が使用している職場を想定します。
（２）そのマクロにバグが発見されたり仕様変更で、マクロの修正が発生したとします。
（３）その配布済みの全てのブックのマクロを読み込みつつ、新しいマクロに置き換えていくというスペシャルマクロを作成する
（４）利用者には予め修正予定日時を周知し、その間は使用しない旨連絡し、スペシャルマクロを実行する。
完了したらその旨連絡して終了。

以下はスペシャルマクロのサンプルです。
長々と書きましたが、ここでようやく題名のVisual Vasic Editorを操作するロジックが必要になります。

Sub ModuleInportAll()
    Dim i As Integer
    Dim cPath
    Dim oVBC As VBComponent
    Dim cSavePath As String, cKaku As String, lFileName As String, lName As String
    Dim lFlg As Boolean
   
    If vbYes <> MsgBox("インポート対象のブックをアクティブにしてください。" & Chr(10) & _
            "VBAProjectにパスワードが設定されている場合は解除しておいてください。" & Chr(10) & _
            "実行しますか？", vbYesNo + vbQuestion, "実行確認") Then Exit Sub
   
    'ファイル指定＆パス、拡張子取得
    cPath = Application.GetOpenFilename("*.*ﾌｧｲﾙ (*.*), *.*", MultiSelect:=True, Title:="★★★ ﾌｧｲﾙ選択 ★★★")
    If Not IsArray(cPath) Then Exit Sub
   
    For i = 1 To UBound(cPath)
        cSavePath = Left(cPath(i), InStrRev(cPath(i), "\"))
        cKaku = Mid(cPath(i), InStrRev(cPath(i), "."))
        lFlg = False
        For Each oVBC In ActiveWorkbook.VBProject.VBComponents
            lFileName = oVBC.Name & cKaku
            If Dir(cPath(i)) = lFileName Then
                lFlg = True
                lName = oVBC.Name
                Exit For
            End If
        Next oVBC
       
        'モジュールが存在したら入れ替え、存在しなかったら追加
        With ActiveWorkbook.VBProject
            If lFlg = True Then
                .VBComponents.Remove .VBComponents(lName)
                .VBComponents.Import (cPath(i))
            Else
                .VBComponents.Import (cPath(i))
            End If
        End With
    Next

    Set oVBC = Nothing
End Sub

解説すると、予め修正後のマクロをエクスポートしておき、上記のロジックで既存のマクロを置き換えていきます。
マクロを実行するには下記３点の注意が必要です。
・Microsoft Visual Basic for Application Extensibilityの参照設定が必要になります
・アクティブブックのVBAProjectにパスワードが設定されている場合は解除しておきます
・Excel2002からはセキュリティが強化されているらしく、「プログラミングによるVisual Basic プロジェクトへのアクセスは信頼性に欠けます」というエラーメッセージが表示されます。そのような場合は、Excelメニュー「ツール」→「マクロ」→「セキュリティ」→「信頼できる発行先」→「Visual Basicプロジェクトへのアクセスを信頼する」にチェックしてから実行するようにします

さて、ロジックの中身ですが、GetOpenFilenameで予めエクスポートしておいた.basファイルを読み込み、For i = 1 To UBound(cPath)でモジュール単位に処理を繰り返します。少し汎用的に、同じモジュールが存在したら入れ替え、存在しなかったら追加する作りにしています。
よかったらお試しください。

今回はカスタムツールバーのボタンからマクロへ引数を渡す方法です。
いろいろ機会のある度に調べたり試したりして出来なかった長年の疑問がやっと解決してとてもスッキリした気持ちです。
複数のボタンから同一のプロシージャを設定すれば当然同じ機能が実行されますね。でも、ボタンによって微妙に処理を切り分けたいときに、ボタン数分プロシージャを作成するのはロジックが冗長的になりメンテナンスが煩雑になります。そこで、ボタンから実行するプロシージャは一つで、どのボタンから実行されたかを引数で判定すれば、共通処理とボタン固有のロジック部分とでスッキリとします。ではその手順を以下に記述します。

（１）プロシージャ側の記述（イメージ）
プロシージャはPublicで作成します。Privateだとボタンから呼び出せないようです。
引数はOptionalで受け取ります。

Public Sub Main(Optional pArg As Integer)

     共通処理
    
     'ボタン固有の処理
     Select Case pArg
     Case 1
        ボタン１の処理
     Case 2
        ボタン２の処理
     Case 3
        ボタン３の処理
        ・
        ・
        ・
     End Select
    
End Sub

（２）カスタムツールバー側の設定
カスタムツールバーを作成し、ボタンを配置します。
ボタン１の「マクロの登録」のマクロ名の設定を @@@@@.xls!'Main 1'と、プロシージャ名 ＋ ブランク ＋ 引数をシングルクォートで括ります。ボタンごとに別の引数を設定してやれば処理を切り分けることができます。

シングルクォートで括るところがポイントです。市販のマニュアル本などでは結構当たり前のテクニックだったりするのかもしれませんがこれを発見したときは本当にうれしかった！！お試しください。

今回は職場で問題になったExcelブックのファイルサイズ肥大化解消について書いてみたいと思います。ネットで検索するといろいろと情報はありますが、私の経験から確実にファイルサイズが縮小するワザをご紹介します。
そもそもExcelブックのファイルサイズの肥大化とはなにかというと、あるファイルをずっと修正したりしていくとファイルサイズがどんどん大きくなるということです。これはAccessでもWordでも言える事です。ではなぜこのようなことが起きるのでしょう。その原因が分かれば解決法も分かります。Excelについて言えば原因と解決方法は以下のようなものです。ちなみにExcel2000/2003で有効であることを確認しています。

■原因
（１）ExcelVBAを何度も修正して保存を繰り返すことによりファイルサイズが増大
（２）「ブックの共有」設定で複数人がファイルを更新することにより、”変更履歴”が増大
（３）見た目以上のデータがシートに入力されているとExcelが認識している
（４）罫線や関数、条件付き書式や入力規則を大量に設定している
（５）ビットマップやグラフなどが貼ってある
（６）ブック内に大量のシートが追加された（シートが非表示になっていて見た目は少ない場合もある）
（７）もともと図などのシェイプオブジェクトが貼り付いていたが行を削除したため、見た目はオブジェクトが見えない

■解決方法
（１）Visual Basic Editorを開き、モジュールを選択し右クリックメニューから「Moduleの解放」→「削除する前にModuleをエクスポートしますか？」→「はい」で一旦モジュールを削除およびbasファイルを出力します。
次にモジュールを選択し右クリックメニューから「インポート」でbasファイルを取り込みます。
これを標準モジュールだけでなくユーザフォームやクラスモジュールについても繰り返すとファイルサイズが縮小します。モジュールを多く含むブックだと効果が大です。

（２）Excelメニュー「ツール」→「ブックの共有」→「編集」タブの「複数のユーザーが同時に編集する」のチェックを外し、変更履歴を削除し、一旦ブックを保存します。再度ブック開き、ブックの共有を設定しなおします。
変更履歴が不要であれば、始めから「詳細設定」タブの「変更履歴を保存しない」を設定しておけばよいです。

（３）ちょっと解説すると、Excelは一旦入力したセルをずっと記憶しているようで、セルをクリアしても記憶し続けます。Ctrl+Endキーを押下してみるとExcelが認識している最終セルが分かります。したがって、仮に見た目は入力が無いというシートでも、この範囲が大きければ大きいほどブックサイズが大きくなります。
これを解消するには、Ctrl+Endキーを押下してジャンプしたセルから入力されている行、列までの未入力部分を選択し、
メニュー「書式」→「スタイル」→「スタイル名」が”標準”でなければ一旦”標準”に設定し、選択している行および列を削除します。ブックを保存すればファイルサイズが縮小しているはずです。スタイルを”標準”に戻さずにただ行や列を削除したのではファイルサイズは縮小されないので注意してください。

（４）（５）はできるだけ使用しないとしか言えません。でも便利だから使ってしまいますよね。必要に迫られて使用しているのであればこれ以上は縮小できませんね。

（６）は可能であればブックを分割するしかありませんね。たまに、既存のブックを流用して作成していたりして、流用元のブックにシートが隠れていたりします。非表示シートはメニューの「書式」→「シート」→「再表示」で確認し、不要であれば削除しましょう。

（７）見た目は何も入力が無いシートのブックがやたらファイルサイズが大きい場合があります。誰かと共同でブックを修正していたりして、自分以外がオブジェクトもろとも行を削除したりすると削除された行の上にあったオブジェクトは点の状態になってしまいます。試しにツールバー上で右クリックし「図形描画」を選択するとツールバーが追加されますので、矢印マークの「オブジェクトの選択」でシート全体を選択し、Deleteキーを押下してみると隠れているオブジェクトが削除されるかもしれません。私が作ったE2000Toolsにはアクティブシートのオブジェクトの一括削除機能がありますので、それを実行してみると便利だと思います。E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

以上がこれまで解決できたケースです。自分のケースに当てはまる場合は試してみてください。

今回はE2000Tools から外れて Outlook VBA について書いてみたいと思います。以前OutlookをVBAで機能拡張する方法をいろいろご紹介しました（http://peiyorin.cocolog-nifty.com/blog/2007/04/outlook_vbaoutl_6589.html など）が、実は仕事で使用していたところ知らない間にツールバーに追加したはずのメニューが表示されなくなり、VBEやセキュリティの実行が全く応答しなくなる現象が発生しました。仕事で使用しているのはOutlook2003なのですが、私だけでなく、そのVBAマクロを導入しているほかの同僚も発生しました。まず始めに同僚のPCにその現象が発生し、いろいろ調べたのですが分からず、結局PCを交換したのでした。そのうち私も同じ現象が発生し、これはやばい！私もPC交換か？と思ったのですが、ある時ふと、Windows Officeのパッチが関係しているかもと思い、Outlookの「ヘルプ」→「バージョン情報」を確認したのです。と、そこに見たこともない「使用できないアイテム」なるボタンがあり、このボタンをクリックすると、vba addinが”無効”になっているではありませんか。これだ！と思い、”有効”にするとVBEもセキュリティ設定も復活しました。Outlookを再起動すると、無事メニューも追加されるようになりました。いろいろ事象をネットでも調べたのですがやはり、「使用できないアイテム」というキーワードが分からないとなかなかヒットしないものですね。改めて検索すると、msdnの下記文書に辿り着きました。勝手に無効にするなよなぁ。。。PC交換しなくて良かった。皆さんもお気をつけください。

～msdnからの引用～
Microsoft Office アプリケーションでは、読み込み中に予期しない動作を行うアドインを無効にする場合があります。アドインをデバッグしようとしたときに、アプリケーションでそのアドインが読み込まれない場合は、アプリケーションによってアドインがハードに無効化された、またはソフトに無効化された可能性があります。

こちらhttp://cat.zero.ad.jp/iizy/からOutlook VBAツールであるO2003Toolsをダウンロードした方でOutlook2003でご利用の方もご参考になさってください。

第24回目の今回は、「選択セルの値を指定区切り文字で区切る」機能です。

皆さんは、Excel標準のメニュー「データ」→「区切り位置」を利用することはありますか？なかなか便利な機能だと思うのですが、区切り文字「その他」に全角文字が指定できません。さらに”タブ区切り”の文字列で区切ることが出来ません。
どうもExcel2003からは全角文字が指定できるようになったようですが。。。
今回ご紹介する「選択セルの値を指定区切り文字で区切る」機能は、指定された文字は何でも区切り文字とすることが出来ます。さらに特殊文字であるタブで区切りたい場合は\tと指定すれば区切ることが出来ます。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第23回目の今回は、「タブオーダー設定」機能です。

皆さんは、Excelシート上でいくつかの決まった列に順番に入力したりする作業をしたりする場合がありませんか？また、セルの決まった位置に画像を貼り付けたりすることはありませんか？
今回はちょっとマイナーと思われる「タブオーダー設定」機能をご紹介します。
例えば、Ｃ列、Ｆ列、Ｋ列といった飛び飛びの列に１行目から２０行目まで入力していく作業があったとします。
そんなときに、任意の行で構わないのですがＣ列、Ｆ列、Ｋ列をCtrlキーを押下しながらクリックした状態で、「タブオーダー設定←→解除」ボタン をクリックすると、「タブ」メニューに列情報が記憶されてます。その状態でキーボードのTabキーを押していくとどうなりますか？実際試してみてください。
そうです、記憶したＣ列、Ｆ列、Ｋ列しかカーソルが行かなくなりましたね。任意の入力フィールドがある定型文書の入力位置をあらかじめ登録しておくのも良いですね。また、所定の位置に画像を貼り付けていくような場合もいちいちセル位置を気にせず美しく張り付けていくことが出来ます。
あまり需要は無いかもしれませんが何かの時によかったらご使用になってみてください。

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第22回目の今回は、「アクティブブックの所在を把握」です。

皆さんは、開いたファイルがどこのフォルダに格納されていたのかとか、前回開いたファイルを開きたいがどこに格納されていたか思い出せない、といったことで困ったことはありませんか？今回はE2000Toolsツールが提供している機能のうち、そういった困り事を解決するいくつかの機能を特集します。
まずは、前回開いたファイルを素早く開くには、以前ご紹介しましたが「ファイル履歴」機能です。
開いているファイルをこれかも頻繁に開きそうな場合は、「アクティブブックのショートカットをデスクトップに作成」で、デスクトップにショートカットを作成してしまいましょう。いずれの機能もファイル数が多くなってくると履歴やデスクトップが煩わしくなってきますが。。。
さらに今開いているファイルの格納フォルダを見たい場合は、「アクティブブック格納フォルダ表示」をクリックすると便利です。アクティブブックの格納フォルダをエクスプローラが表示してくれます。
実は、E2000Toolsツールを導入すると、タイトルバーにアクティブブックのフルパスとファイルサイズが表示されるようになるのでファイルの所在把握は大抵はそれで事足りますが。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第21回目の今回は、「直前のシートへジャンプ」機能です。

皆さんはExcelブック内のとても離れた２つのシートを交互に見ながら作業をすることってありませんか？大抵はExcel標準機能のメニュー「ウィンドウ」→「新しいウィンドウを開く」で該当のシートを２つ並べて作業もしくは、２つのシートを左右に並べてCtrl+PageUp/PageDown！で表示切替えってことになると思いますが、そこまでしなくても、ちょっと参照するだけといった場合、「直前のシートへジャンプ」機能はアイコンクリック一発で２つのシートの表示を切替えることが出来ます。別ブック間のシートでも切替えられます。よかったらご使用になってみてください。

このアイコン をクリック

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第20回目の今回は、「アクティブセルの文言を単語登録」機能です。

皆さんは、いきなりですが日本語入力（今でもＦＥＰていうのかな？）の用語辞書って利用していますか？文章を入力していてよく入力する単語や短い文章、業界用語などを登録しておくと便利ですよね。MS-Wordなどは用語の登録がスムーズに出来ますが、Excelを使用していて「あっ、この単語を登録しておこうかな」と思ったときはＦＥＰの用語辞書機能をわざわざ起動して登録することになりちょっと面倒ですね。
今回ご紹介する「アクティブセルの文言を単語登録」機能は、アイコンクリック一発でアクティブなセルの文言を単語登録画面にコピーします。あとは、「読み」を入力すればスムーズに単語登録することが出来ます。

このアイコンをクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第19回目の今回は、「全シート表示／アクティブシート非表示」機能です。

皆さんは、非表示になっているExcelシートを表示する際に一つ一つ指定し行かなければならず、いらついたことはありませんか？E2000Toolsツールでは以下の表示／非表示機能を提供しています。

E2000Toolsｷｰ設定Sample.txtのシートタブの設定[SheetTabMenu]を自分のiniファイルにコピーして、シートタブ上で右クリックをするとこのアイコン が表示されるようになります
・全シート表示機能
　非表示になっているシートを全て表示します
　
・アクティブシート非表示機能
　アクティブシート（複数選択状態でもOK）を非表示にします
　

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第18回目の今回は、「選択行一括セル結合」機能です。

ちょっと説明が難しいので下記例をご覧頂きたいのですが、今回ご紹介する「選択行一括セル結合」機能を実行すると、選択した行のそれぞれのセルを、指定した列数分セルを結合します。つまり、縦方向の行はそのままに、横方向の列だけセル結合するというものです。
私はセル結合が大嫌いなのですが、当機能の利用価値は、表を作成する場合セル幅を調整しなくてもセル結合で思ったとおりの表が作成できるという点です。なお、実行する前にR1C1表示形式（列見出しが数字表示のやつ）にしておくと指定しやすいでしょう。R1C1表示形式への切替えは第９回の「いろいろな切り替え」機能http://peiyorin.cocolog-nifty.com/blog/2007/06/e2000tools_1e80.htmlをご覧ください。

このアイコン をクリックした後に
　　　　例：列11の行1,2を選択し、"列12まで結合"指定した場合
　　　　 11  12  13
　　　１┌┐┌┐┌┐　　　　　┌──┐┌┐
　　　　└┘└┘└┘　　　　　└──┘└┘
　　　２┌┐┌┐┌┐　→　　 ┌──┐┌┐
　　　　└┘└┘└┘　　　　　└──┘└┘
　　　３┌┐┌┐┌┐　　　　　┌┐┌┐┌┐
　　　　└┘└┘└┘　　　　　└┘└┘└┘

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

～2007.07.02追記～
今日会社で知ったのですが、どうやらExcel2003に全く同じ機能があるようです。
それも、アイコンも偶然同じ。さすが本家のほうが結合列番号を入力しなくても選択するだけで結合してくれるようです。知らなかった。。。
きっとExcel2000ユーザには便利でしょう！（うん）

第17回目の今回は、「重複排除」機能です。

皆さんは、Excelのある列の入力値の重複を取り除いた結果を知りたくなることはありませんか？
重複排除したい列を仮にA列とすると、A列をソートし、A列の横に=Exact("A1","A2")関数を設定し、かつ重複排除したい最終行までコピーし、フィルタで”False”を指定すれば重複を排除した結果を取得できますが面倒ですね。今回ご紹介する「重複排除」機能は、前述の一連の動作をマクロ化したものです。
重複を排除したいセル範囲を選択して当機能を実行すると、選択列の右横に２列追加し、選択行の値をコピーした列と、さらにその横の列に=Exact("A1","A2")関数を埋め込み”False”でフィルタを掛けた状態で終了した列が作成されます。作業が終わればマクロが追加した２列を削除すれば元通りというわけです。
正しく実行するためには選択範囲の先頭にフィルタのための見出しが必要です。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第16回目の今回は、「ブック一括終了」機能です。

皆さんは、Excelで複数ブックを閉じる場合もしくは、とりあえず全部保存したいといった場合どうされていますか？やはり１ブックずつ×ボタンで終了や保存を繰り返しているのでしょうか？
そんなときに、E2000Toolsツールは以下の機能を提供しています。

このメニューアイコン をクリック
・全ファイルを保存せずに終了
　オープンしているブックを保存せずに一括終了します。
　
・全ファイル保存終了
　オープンしているブックを一括で保存終了します。
　
・全ファイル上書き保存
　オープンしているブックを一括で保存します。終了はしません。
　

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第15回目の今回は、「連番付与」機能です。

皆さんは、行番号を振る場合どうされているでしょうか？先頭行１固定で以降に=R[-1]C+1や、=Row()+1などの関数を埋め込んでいるのではないでしょうか？通常は問題ありませんが、ある条件でソートした後で元の状態に戻したいとした時にはもう元の番号は訳が分からなくなってしまいますね。
そういったケースでは直打ちで連番を振っておくことが必要になります。
今回ご紹介する連番付与はアイコン一発クリックで連番を付与する機能です。ちょっと慣れが必要ですが、２パターンの連番を付与することができます。アクティブセルが空白の場合は１から連番、なにか値が入っている場合はその値の次から連番を付与することが出来ます。アルファベットの場合はその順番に振ることが出来ます。また、”その１”などと記入されている場合”その２”、”その３”．．．．と数字部分を連番設定することも出来ます。
アクティブセルのすぐ右側に入力されているセルまで連番を付与していきますので、途中で空白があるとその直前で終了してしまう仕様になっています。ちょっと説明が難しいですが、ぜひ、ご使用になってみてください。

このアイコン をクリック

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

第14回目の今回は、「ファイル名一括変換」機能です。

皆さんは、あるフォルダに格納されているファイルを一括変換したいと思ったことはありませんか？
今回ご紹介する「ファイル名一括変換」機能を実行すると、新規ブックファイルが作成され、変換元ファイル名と変換後ファイル名を一覧上に定義すると、定義に従ってファイル名を一括変換することができます。その際に、前回ご紹介した「指定フォルダ配下のファイルを一覧化」機能で変換元ファイル名のリストを作成すれば便利です。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。不明な点などがあればコメント欄にでも書いて頂ければお答えしたいと思います。

今回は初登場ですが、Access VBAについて書いてみたいと思います。
皆さんはAccessのデータをExcelで表示させたいと思ったことはありませんか？
たまたま、仕事の関係でこれまでＥｘｃｅｌで管理していた表がExcelの行制限65536行を超えそうだということでAccess化しようということになり、これまでExcel VBAの処理をAccess VBAに変更したのでそのマクロのエッセンスを公開してみようと思いました。
今回ご紹介するのは、Excel側からAccessのデータを、シートに貼り付ける方法とユーザフォームのリストボックスに表示する方法の２通りです。Accessのデータをシートに貼り付けられるのであれば、そもそもAccessにする必要はないじゃないかとお思いになる方がいらっしゃると思いますが、そこはまぁ置いておきましょう。で、以下がそのマクロです。

Public MyArray()
Public Const cGetFld As Integer = 5
Public Const cDbPath As String = "anime.mdb"
Public Const cSqlText As String = "Select * from アニメタイトル"

'新規ブックにデータ貼り付け
Private Sub m_GetAccessData()
    Dim i As Integer, j As Integer, k As Integer, l As Integer
   
'    Cells.ClearComments
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
   
    Workbooks.Add
   
    Call mGetAccessData
   
    k = 1
    For i = 1 To UBound(MyArray, 1)
        k = k + 1
        l = 0
        For j = 1 To UBound(MyArray, 2)
            l = l + 1
            Cells(k, l).Value = MyArray(i, j)
        Next
    Next
   
    Range(Cells(1, 1), Cells(1, 5)) = Array("タイトル", "放送開始日時", "曜日", "放送終了日時", "視聴局")
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.Zoom = 85
    Columns("C:C").Select
    Selection.NumberFormatLocal = "aaa"
    Columns("C:C").EntireColumn.AutoFit
    Range("A1").Select

    Erase MyArray
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = False
End Sub

Public Sub mGetAccessData()
   
    Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
    Set oDb = wrkJet.OpenDatabase(ThisWorkbook.Path & "\" & cDbPath, False)
    Set oRst = oDb.OpenRecordset(cSqlText, dbOpenDynaset, dbReadOnly)
   
    oRst.MoveLast
    ReDim MyArray(1 To oRst.RecordCount, 1 To cGetFld)
   
    Dim i As Integer, j As Integer, k As Integer
    oRst.MoveFirst
   
    With oRst
        Do While Not .EOF
         Doevents
            i = i + 1
            k = 0
            For j = 1 To cGetFld
                k = k + 1
                MyArray(i, k) = .Fields(j)
            Next
            .MoveNext
        Loop
    End With
    oDb.Close
    Set wrkJet = Nothing
    Set oDb = Nothing
    Set oRst = Nothing
   
End Sub

～ユーザフォーム～
'リストボックスにデータ貼り付け
Private Sub UserForm_Initialize()
    Call mGetAccessData
    Me.ListBox1.ColumnCount = cGetFld
    Me.ListBox1.List() = MyArray
    Me.Label1.Caption = UBound(MyArray, 1) & "件"
    Erase MyArray
End Sub

それでは、解説していきます。まず、Accessデータベースの情報をConstで設定しています。今回は以下のようなデータベースを前提に処理します。
＜anime.mdb＞
テーブル名：アニメタイトル
id　　　　　 　　　 オートナンバー型 主キー
タイトル　　 　　　テキスト型
放送開始日時　日付／時刻型
曜日　　　　 　　 日付／時刻型
放送終了日時　日付／時刻型
視聴局　　　 　　テキスト型

まずAccessデータをシートに貼り付ける処理です。
m_GetAccessDataモジュールがメイン処理となりますが、新規ブックを作成し、mGetAccessDataでAccessデータを配列に格納し、その配列データをシートに貼り付け、整形して終了となります。
で、肝心のAccessデータの取得部分であるmGetAccessDataモジュールですが、VBEの参照設定には以下を追加することが必要ですのでご承知置きください。
    ・Microsoft ActiveX data Objects 2.8 Library
    ・Microsoft Access 11.0 Object Library
    ・Microsoft DAO3.6 Object Library
で、Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)でワークスペースの作成し、Set oDb = wrkJet.OpenDatabase(ThisWorkbook.Path & "\" & cDbPath, False)で指定のデータベースをオープンし、Set oRst = oDb.OpenRecordset(cSqlText, dbOpenDynaset, dbReadOnly)で指定のＳＱＬを実行し、レコードセットオブジェクトに格納するといのが一連の流れです。この辺はＤＡＯやＡＤＯなどいろいろやり方あって私も良く理解していなのですが、ヘルプの記述そのままですので詳細はヘルプをご確認ください。ネット上にも解説したサイトがいろいろあると思います。
前述したとおり、cSqlTextで定義しているＳＱＬ文は全件取得ですので場合によってはWhere句で条件を絞る必要があるでしょう。ヘルプによるとパフォーマンスに影響するらしいのですが、oRst.MoveLastで一旦最終行までカレント行を移動し、予めoRst.RecordCountで件数を取得しています。で、oRst.MoveFirstで先頭行にカレント行を移動してＥＯＦまでレコードのフィールド情報を配列に格納して終了となります。

次に、ユーザフォームのリストボックに表示する方法です。まずユーザフォームを作成してリストボックを配置します。で、上記のPrivate Sub UserForm_Initialize()を貼り付けてUserForm1.Showを実行すれば表示されます。

レコード件数が多くなるとどうなるか解りませんが、どちらの方法も思ったよりも結構高速です。
anime.mdbと上記マクロをアップロードしておきますので実際に動かして試してみてくださいね。

「GetAccessData.EXE」をダウンロード

以前「定型フォーマットのＥｘｃｅｌを一気に開いて複数作成するマクロ」シリーズをやった際に、定型フォーマットはＷｏｒｄでもできますよとコメントしましたが、今回はその例をご紹介いたします。
仕様はＥｘｃｅｌと同じです。フォーマットもＥｘｃｅｌと同じにしてみました。
詳細はこちらをご確認ください。http://peiyorin.cocolog-nifty.com/blog/2007/05/excel_vba_2f7d.html
以下がそのマクロです。

'申請書一覧
Const cStRow As Integer = 3
Const 部署col As Integer = 2
Const 申請者col As Integer = 3
Const 承認者col As Integer = 4
Const 承認日col As Integer = 5
Const 機能名col As Integer = 6
Const 依頼事項col As Integer = 7
Const 処理日col As Integer = 8
Const ファイル名col As Integer = 9
Const 更新日col As Integer = 10

Sub Wordファイル取り込み()
    Const cDefPath As String = "c:\work"
    Const cMyWs As String = "申請一覧"
   
    Set oMyWs = ThisWorkbook.Sheets(cMyWs)
   
    'クリア確認
    If vbYes = MsgBox("一覧をクリアしますか？", vbYesNo + vbQuestion, "クリア確認") Then
        lLastRow = oMyWs.Cells(65500, 部署col).End(xlUp).Row + 1
        oMyWs.Range(oMyWs.Cells(cStRow, 部署col), oMyWs.Cells(lLastRow, 更新日col)).ClearContents
    End If
   
    'フォルダ指定
    ChDrive Left(cDefPath, 1)
    ChDir cDefPath
    FileDir = Application.GetSaveAsFilename("DUMMY", "Wordﾌｧｲﾙ(*.doc),*.doc", , "■■■ ﾌｫﾙﾀﾞ指定 ■■■")
    If FileDir = "False" Or FileDir = "FALSE" Then Exit Sub
    FileDir = Mid(FileDir, 1, InStrRev(FileDir, "\") - 1)
   
   
    'ファイル情報取り込み
    Set wd = CreateObject("Word.application")
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getFolder(FileDir)
   
    For Each oF In f.Files
        If Not (IsNumeric(Left(oF.Name, 8))) Then GoTo next_oF
        If Not (oF.Name Like "*.doc") Then GoTo next_oF
       
        Set oActDoc = wd.documents.Open(Filename:=FileDir & "\" & oF.Name, ReadOnly:=True)
       
        For Each oTb In oActDoc.Tables
            lLastRow = oMyWs.Cells(65500, 部署col).End(xlUp).Row + 1
            oMyWs.Cells(lLastRow, 部署col).Value = Application.Substitute(oTb.Range.Rows(1).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 申請者col).Value = Application.Substitute(oTb.Range.Rows(3).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 承認者col).Value = Application.Substitute(oTb.Range.Rows(5).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 承認日col).Value = Application.Substitute(oTb.Range.Rows(7).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 機能名col).Value = Application.Substitute(oTb.Range.Rows(9).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 依頼事項col).Value = Application.Substitute(oTb.Range.Rows(11).Range.Cells(2).Range.Text, "", "")
            oMyWs.Cells(lLastRow, 処理日col).Value = Now()
            oMyWs.Cells(lLastRow, ファイル名col).Value = oF.Name
            oMyWs.Cells(lLastRow, 更新日col).Value = oF.DateLastModified
        Next
        oActDoc.Close
next_oF:
    Next

    Set fs = Nothing
    Set f = Nothing
    Set oF = Nothing
    Set wd = Nothing
    Set oDc = Nothing
    Set oTb = Nothing
    Set oActDoc = Nothing
   
End Sub

それでは解説していきます。まず始めに、前回は申請書一覧.xlsにボタンを用意してＥｘｃｅｌファイルを一覧化していましたが、同様にWordファイルを取り込むためのボタンを追加して、上記マクロを実行するように設定します。
でこれも前回と同様ですが、申請書一覧の列位置情報を定義しています。これは前回の記述と冗長ですが気になる方はもちろん一つに集約して頂いて結構です。で、実際の処理ですが、基本構造は前回のＥｘｃｅｌ版と変わりませんのでＷｏｒｄ固有の部分に絞って解説します。「ファイル情報取り込み」では、Set wd = CreateObject("Word.application")でＷｏｒｄオブジェクトを生成し、Set oActDoc = wd.documents.OpenでＷｏｒｄファイルを読み取り専用でオープンし、For Each oTb In oActDoc.TablesでＷｏｒｄ文書のテーブル情報を取得して繰返し処理を行っています。Ｗｏｒｄに表を作成した場合はTablesで情報を取得することになります。そのテーブルに対して、Application.Substitute(oTb.Range.Rows(1).Range.Cells(2).Range.Text, "", "")という命令で一つ一つのセルごとに情報を取得します。Range.Rows(1)が行、
Range.Cells(2)が列の配列を表します。Substituteで""を""に変換していますがこれは変換しなかった場合と変換した場合を試してみれば解ると思います。oActDoc.CloseでオープンしたＷｏｒｄファイルをクローズして１ファイル分終了です。これを指定したフォルダ配下のＷｏｒｄファイル分処理を繰り返すというわけです。

申請書一覧.xlsの改訂版と定型フォーマットのＷｏｒｄファイルをアップロードしますので実際に動作させて確認してみてくださいね。

「sinsei_sample2.EXE」をダウンロード

第13回目の今回は、「指定フォルダ配下のファイルを一覧化」機能です。

皆さんは、あるフォルダに格納されているファイル名を一覧にしたいと思ったことはありませんか？
Windowsのコマンドプロンプトにdirがありますが、c:\>dir > c:\dir.csvなどとやってもその後加工が必要であったりと面倒ですね（ほかに方法知ってます？）。
本当に単純にファイル名の一覧が欲しい場合、今回ご紹介する「指定フォルダ配下のファイルを一覧化」機能が便利です。
当機能を実行すると、アクティブなセルに、指定したフォルダのファイル情報を一覧化します。
貼り付ける情報はファイルフルパス、ファイルパス、ファイル名、ファイルサイズ、最終更新日です。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第12回目の今回は、「アクティブセル一発ネット検索」機能です。

最近はGoogleやYaphooなど検索エンジンが便利で、ネットを検索すれば知りたいことは大抵見つかりますね。（内容の真偽は自己責任ですが）
皆さんは、検索エンジンを使用する場合、Internet Exploreなどのブラウザを起動して検索用語を入力して検索！といったことをしていますか？いまの職場ではほとんどの文書はExcelで作成しているのでほとんどの時間Excelを起動しています。今回ご紹介する「アクティブセル一発ネット検索」機能は、セルの入力値をキーにクリック一発でネットを検索する機能です。E2000Tools.Iniファイルに予め好みのブラウザパスと検索エンジンを設定しておけば好みの検索が可能です。デフォルトではInternetExploreでMSNを検索します。当機能をショートカットキーに登録しておけばさらに便利になるでしょう。私はCtrl+Alt+nで登録しています。ショートカットキーのカスタマイズ機能は後日ご紹介いたします。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第11回目の今回は、「ファイルタイムスタンプの変更」機能です。

皆さんは、他人が作成したExcelファイルを参照目的で開いたにも拘らず思わず保存してしまい、タイムスタンプを更新してしまったことはありませんか？通常はあまり問題にはなりませんが、ファイルの最終更新日を見て作業している場合や、構成管理ツールなどを使用している場合などはあまりよろしくないこともありますね。
そこで、今回ご紹介するファイルタイムスタンプの更新機能ですが、指定したファイルのタイムスタンプを改ざん、もとい変更することができます。ファイルはExcelに限らずなんでもOKです。（たぶん）
他人のファイルを思わず更新してしまったお茶目なあなた！ぜひご使用になってみてください。

このアイコン をクリック

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第10回目の今回は、「目次作成」機能です。

皆さんは、１つのブックの中にものすごいたくさんのシートが存在している場合シートの切り替えはどうしていますか？
横スクロールを延々と行わなければならず面倒ですね。実はExcel標準機能として、この左右スクロールボタン上で右クリックすると全シートのリストがポップアップされるのですがご存知でしたか？意外と知られていないのではないかと思うのですが私だけでしょうかね。同僚が操作をしているのを何気なく見ていて驚いたのを覚えています（笑）。これはこれで良い機能だと思うのですが、シート数が多いと全て表示されないのが難点です。そこで、今回ご紹介する目次機能です。
当機能は、新規シートを追加して、全シートのシート名およびそのシートへのハイパーリンクを生成します。
Excel標準のWebツールバーを表示するようにしておけば”戻る”ボタンがあるので目次シートと移動したシートで行き来が出来て便利です。
シートの追加や削除など状況が変化しても、目次作成を繰り返せばわざわざ目次シートを削除しなくても常に最新の目次が生成されます。目次が不要になればシートを削除すればよいわけです。

このアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

皆さんの中でマクロを作成している方がいらっしゃると思いますがＡ１形式とＲ１Ｃ１形式で表示を切替えたくなりませんか？Range("A1").Valueなどと処理する場合はＡ１形式で表示されていた方が作業しやすいですし、Cells(i,10).Valueなどと処理する場合はＲ１Ｃ１形式の表示が便利です。また、改頁プレビュー表示か標準表示か、自動計算モードか手動計算モードかといった切り替えはメニュー「ツール」→「オプション」でいちいち切替えるのは面倒ですね。
そこでE2000Toolsツールは以下の機能を提供しています。標準では以下のようにツールメニューから指定しなければならないので多少面倒に感じるかもしれませんがE2000Toolsツールはショートカットキーや右クリックメニューのカスタマイズ機能があるので自分の好みに設定できます。画像のように、Ctrl+Alt+PageDownなどで即時に切替えることができるようになります。

このメニューアイコン をクリックすると

・A1←→R1C1参照形式
　　A1←→R1C1の表示を切り替えます。

・標準表示←→改頁ﾌﾟﾚﾋﾞｭｰ表示
　　標準表示←→印刷ﾌﾟﾚﾋﾞｭｰ表示を切り替えます。

・自動計算←→手動計算切り替え
　　手動計算と自動計算を切り替えます。

・下にカーソル移動←→右にカーソル移動切り換え
　　Enterキー押下時カーソル下移動カーソル右移動を切り換えます。
　　ステータスバーに瞬間表示します。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第８回目の今回は、「不正なリンクを解除」機能です。

皆さんは、意識しないうちにいつのまにか他のブックとリンクが張られてしまい、ブックを開くと「リンクを更新しますか？」的なメッセージが表示されるようになってしまって困ったことはありませんか？特に、どのシートのどのセルが原因なのか不明なのが困りますね。この原因は、他のブックと、セル参照などのリンクが設定されている場合と、他のブックの名前を取り込んでしまった場合の２つが考えられます。
そこでこのリンクを解消する機能としてE2000Toolsツールは、「不正なリンクを解除」メニュー配下に以下の機能を提供しています。

このメニューアイコン をクリックすると、
（１）全ｼｰﾄの数式を抽出
　　　新規シートを追加し、全シート内の数式を抽出し一覧化します。
      他のブックとリンク状態の数式をピンク色で警告します。
      ハイパーリンクで該当セルにジャンプすることが出来ます。
      
（２）名前のリンク先を一覧表示します。
　　　新規シートを追加し、全ての名前を抽出し一覧化します。
      他のブックとリンク状態の名前をピンク色で警告します。
      
（３）選択した名前を削除する
　　　（２）の名前一覧で選択した名前を削除します。
       
（４）全ての名前を削除する
　　　全ての名前の削除します。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第７回目の今回は、「クリップボード貼り付け」機能です。

皆さんはExcelで作成した表データをメールに貼り付けて送信する場合どうしていますか？
図オブジェクトとして貼り付いてしまって、データを再利用できなかったりしたことはありませんか？
今回ご紹介する「クリップボード貼り付け」機能は、選択したExcelデータをタブ区切りでクリップボードにコピーし､他のプログラムに渡すことが出来ます。イメージとしては以下の通りです。

このアイコン（左側） をクリックすると
┏━━━━┳━━━━━┳━━┓
┃xxxxxxx  ┃ xxxxxxxx 　┃ xxx ┃
┃xxxxxxx  ┃ xxxxxxxx   ┃ xxx ┃
┃xxxxxxx  ┃ xxxxxxxx   ┃ xxx ┃
┃xxxxxxx  ┃ xxxxxxxx   ┃ xxx ┃
┃xxxxxxx  ┃ xxxxxxxx   ┃ xxx ┃
┃xxxxxxx  ┃ xxxxxxxx   ┃ xxx ┃
┗━━━━┻━━━━━┻━━┛
               ↓
　xxxxxxx tab xxxxxxxx tab xxx 改行コード
　xxxxxxx tab xxxxxxxx tab xxx 改行コード
　xxxxxxx tab xxxxxxxx tab xxx 改行コード
　xxxxxxx tab xxxxxxxx tab xxx 改行コード
　xxxxxxx tab xxxxxxxx tab xxx 改行コード
　xxxxxxx tab xxxxxxxx tab xxx 改行コード

上記のとおりメール本文に貼り付けて送信すれば、受信者側は貼り付いているデータを再利用することができます。よかったらご使用になってみてください。ちなみに右側のアイコンはクリップボードクリアです。

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第６回目の今回は、「ソート＆フィルタ」機能です。

皆さんは、他人が作成したExcelを開いたらフィルタが掛かっていて、全体を見たいがどのセルにフィルタが掛かっているのかわからないときがありませんか？また、セルの値によって色分けしてみたが後になって色ごとにフィルタを掛けたいと思ったことはありませんか？さらに、セルの入力値の文字数の小さい順でソートまたは、文字列の逆の文字列順にソートをしたいと思ったことはありませんか？
当ツールの「ソート＆フィルタ」メニュー配下にある機能はそういったご要望にお応えします。

このメニューアイコン をクリックすると以下の機能が表示されます。
（１）ｱｸﾃｨﾌﾞな列のﾌｫﾝﾄ色でﾌｨﾙﾀ支援
    　　アクティブセル列のフォント色の色番号を右横に列を追加し出力します。
    　　追加した列はフィルタ状態になっているのでフォント色でフィルタを掛けることが可能に
    　　なります。不要になれば列毎削除すればよく、既存のシートに影響を与えません。
   
（２）ｱｸﾃｨﾌﾞな列の背景色でﾌｨﾙﾀ支援
    　　アクティブセル列の背景色の色番号を右横に列を追加し出力します。
    　　追加した列はフィルタ状態になっているので背景色でフィルタを掛けることが可能になり
    　　ます。不要になれば列毎削除すればよく、既存のシートに影響を与えません。
   
（３）ｱｸﾃｨﾌﾞな列のﾒﾓｺﾒﾝﾄでﾌｨﾙﾀ支援
    　　アクティブセル列のコメント文字列を右横に列を追加し出力します。
    　　追加した列はフィルタ状態になっているのでコメントでフィルタを掛けることが可能にな
    　　ります。不要になれば列毎削除すればよく、既存のシートに影響を与えません。
   
（４）ｱｸﾃｨﾌﾞな列のﾊｲﾊﾟｰﾘﾝｸでﾌｨﾙﾀ支援
    　　アクティブセル列のハイパーリンク内容を右横に列を追加し出力します。
    　　追加した列はフィルタ状態になっているのでハイパーリンクでフィルタを掛けることが可
    　　能になります。不要になれば列毎削除すればよく、既存のシートに影響を与えません。
   
（５）ﾌｨﾙﾀを解除
    　　フィルタを解除します。どの列にフィルタが掛かっているか分からない場合便利です。
   
（６）ｱｸﾃｨﾌﾞな列で昇順ｿｰﾄ
    　　Excelの昇順ソートはアクティブセル列のみのソートですが、当該機能はアクティブセル
    　　列の文字列をキーにシート全体を昇順にソートします。
   
（７）ｱｸﾃｨﾌﾞな列で降順ｿｰﾄ
    　　Excelの昇順ソートはアクティブセル列のみのソートですが、当該機能はアクティブセル
    　　列の文字列をキーにシート全体を降順にソートします。
   
（８）ｱｸﾃｨﾌﾞな列で文字数ｿｰﾄ
    　　アクティブセル列の文字数の小さい順でシート全体をソートします。
   
（９）ｱｸﾃｨﾌﾞな列で逆引きｿｰﾄ
    　　アクティブセル列の文字列を逆引きでソートします。逆引きソートとは、例えばabcdeと
    　　いう文字列をedcbaと置き換えてソートします。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第５回目の今回は、「文字列付加・抽出」機能です。

皆さんは、既に入力済みのセルの値の先頭や語尾に一律ある文字列を付加したいとか、セル内折返ししているセルに折返しを止めたりとか、セル内の入力値のある部分文字列を取り出したり赤字や強調文字などの書式設定をしたりしたいと思ったことはありませんか？そういった、一括置換でも出来ない、関数でやるのも面倒くさいような編集機能を提供するのが当機能です。ちなみにアイコンはＭ＋（エムプラス）としています。
当機能の内容は以下の通りです。複数選択したセルの文字列に対して様々な加工を施すことが出来ます。

このアイコン をクリックすると以下の画面が表示されます

（１）文字列を前後に付加
　　　前か後ろかそれとも両方かチェックし、付加したい文字列を入力すれば、
　　　選択セルに文字列を付加することが出来ます。
　　　クリップボートに保存されている文字列がデフォルト表示されます。
（２）文字列削除
　　　選択セルの文字列に複数の半角スペース、全角スペースが含まれている場合、
　　　それを除去し最終的に１つだけ残します。但し、スペースが１つの場合は何もしません。
（３）文字列抽出
　　　選択セルの文字列から指定した文字に囲まれた文字列を抽出し、指定した
　　　列に貼り付けます。
　　　例：セルの文字が（ほげほげ）の場合、（ と ）を指定すると ほげほげ
　　　　　を抽出します。
（４）文字列結合
　　　指定した区切り文字と結合方法（横方法に結合か縦方向か）で選択範囲を
　　　結合します。
　　　選択範囲のすぐ右横に結合結果を出力するので注意してください。
（５）部分文字変更
　　　選択範囲のセルに、指定した文字列が存在する場合、その文字列部分のみ
　　　の書式と色を変更することが出来ます。
　　　変更できる内容は以下のとおり
　　　　（ア）強調、斜体、アンダーライン、取消線
　　　　（イ）黒色、赤色、青色、桃色、紫色、緑色

ちょっと多機能で使いこなすには慣れが必要なので、あまり問題にならないセル部分で練習してみてくださいね（笑）。

E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第４回目の今回は、「アクティブブック内／全ブック内串刺し検索」機能です。

皆さんは開いているブックの全シート内、あるいは開いている全てのブック内を横断で検索（以降、これを串刺し検索と呼びます）したいと思ったことはありませんか？
Excel2003からはメニュー「編集」→「検索」→「全て検索」ボタンが追加されたので全シート、全ブックを串刺し検索出来る様になったようですが｡私がこの機能を開発したExcel2000当時は存在しませんでした。
ただ、Excel2000でも全シートを選択した状態で検索すれば串刺し検索は可能でしたが、選択が面倒、全ブックの串刺しができないなどの不満がありました。
Excel2003に実装されたとはいえ、まだE2000Toolsの「アクティブブック内／全ブック内串刺し検索」機能のほうが勝っている点が２点あります！それは、Excel標準機能では検索対象がテキストか数式かメモですが、当機能はシェイプ内を検索することが出来ます。さらに、セル背景色／セルフォント色といった色で検索することが出来ます。これもWordの機能にはありますがなぜかExcelにはありませんね。
では、使用方法ですが以下の通りです。実際にツールの画面を見ていただければ一目瞭然ですが。

このアイコン をクリックすると以下のダイアログが表示されます。

（１）ｱｸﾃｨﾌﾞﾌﾞｯｸ内か全ﾌﾞｯｸ内かを選択します。
（２）文字列であれば検索文字を入力します。ｸﾘｯﾌﾟﾎﾞｰﾄﾞにｺﾋﾟｰされている
　　　文字列をﾃﾞﾌｫﾙﾄ表示します。
　　　色であれば色を選択します。ｱｸﾃｨﾌﾞｾﾙの色番号がﾃﾞﾌｫﾙﾄ表示されます。
（３）文字列検索の場合、全角半角区別や大文字小文字区別、完全一致など
　　　のｵﾌﾟｼｮﾝを設定します。
　　　色であれば、空白セルを検索の対象とするかどうかを選択します。
（４）検索ﾎﾞﾀﾝをｸﾘｯｸすると串刺し検索して行きます。検索が終了すると、
　　　フォーム画面下の情報領域に「～検索が終了しました。」と表示され
　　　、検索を開始したｼｰﾄのｾﾙに戻ります。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第３回目の今回は、「大文字、小文字、全角文字、半角文字、ひらがな、カタカナ変換」機能です。

皆さんは、「あっ小文字で入力すればよかった」「全角を半角に統一したいなぁ」などと後から思ったことはありませんか？そのような場合は大抵再入力されているのではないでしょうか？
当機能は、選択範囲のセルの文字列に対してアイコン一発クリックで、大文字、小文字、全角文字、半角文字、ひらがな、カタカナを相互に何度でも変換することができます。
Wordには標準機能として提供されていますがなぜかExcelにはありませんね。というわけで作成してみました。意外と便利です。

このメニューアイコン をクリック

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

第２回目の今回は、「アクティブな列をキーにして検索値取得」機能です。

皆さんは、作業中のシートのセル値に該当する他のシートの値を検索したくなることはありませんか？つまりシート間で同じ値があるか比較検索したり、比較した結果該当したらその行のある列の値を取得したといったことです。そのような時は大抵、VLOOKUP関数を使用されると思います。ただVLOOKUP関数は比較先の列がソートされていなければならないとか、比較範囲内に列が追加や削除された場合、取得する列番号を変更しなければならないとかいろいろ制約があります。さらに、大量の行に関数を定義するとExcelが重くなりますね。当機能はVLOOKUPの機能をマクロで実現、拡張したものです。
使い方は以下の通りです。

このアイコン をクリックした後に

（１）アクティブシートで検索したいセル範囲を選択します。複数列選択した
　　　場合は最左列と最右列がそれぞれキーとなります。
（２）アクティブシートに検索結果を貼り付ける列を指定します。
　　　デフォルトでは最右列が設定されています。
（３）リストボックスから、検索先のブックを選択します。
（４）Nextボタンを押下し、検索先ブック内のシートを選択します。

（５）検索先シートで検索する列を指定します。２列キーの場合は０（ゼロ）
　　　以外の列をきちんと指定します。
（６）検索列で見つかったときに取得したい値の列を指定します。
　　　取得する列は3-10とか3,4,6,7とか複数指定が可能です。例を参考にしてください。
（７）OKボタンを押下して実行します。見つからない場合は”見つかりませんでした”
　　　が出力されます。
　　　モードレス画面なので、フォーム画面が表示されている間でもシートを操作する
　　　ことが出来ます。
　　　続けて検索したり選択位置に戻りたい場合は、検索位置へジャンプボタン
　　　を押下します。

ちなみに、A1表示でもR1C1表示でも検索指定できます。また、同じブック内のシート同士あるいは新規ウィンドウに対しても検索できます。

よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

今回から、私が作成したE2000ToolsというExcelツールの機能をご紹介していきます。
ますはじめに、E2000Toolsとはどういうツールかというと、本体はただのExcelファイルですが、このファイルを起動すると、Excelに独自ツールバーが表示されるようになります。そのツールバーにはExcelで作業する上で様々な便利機能が盛り込まれています。
今回からその膨大な機能の中から皆さんが頻繁に使っていただけるのではないかと思う機能をピックアップしてご紹介していきます。
ちなみに私の使用しているExcelは2000と2003ですが、今後「この機能はExcel標準にはない」とか言及するかとは思いますが最新バージョンのExcelには実装されているかもしれません。その辺はどうかご了承ください。
なお予めお断りしておきますが、当ツールを使用した際のいかなる損害にも私は責任を負えませんので、ご自身の責任と冒険心と好奇心とでご使用ください。ツール実行前のブックの保存を励行してくださいね。（私も日常的に使用しているのExcelが落ちたりはしないはずですが）

第１回目の今回は、「ウィンドウの並べ替え」機能です。

皆さんはExcelで作業をする場合はブックは１つだけ開いて行いますか？おそらく複数のブックを開きながら作業することが多いのではないでしょうか？場合によっては１０とか２０とか開いたりしませんか？そういった場合、大抵はExcel標準機能であるメニュー「ウィンドウ」→「整列」→「重ねて表示」などブックを整列したり、「ウィンドウ」の下部に表示されるウィンドウを切り替えたり、Ctrl+Tabキーで切替えたりすると思います。いずれにしても手間が掛かったり希望のウィンドウにたどり着くのに時間が掛かりますね。そこでE2000Toolsはアイコン一発クリックで以下の様々な並べ替えを提供しています。

このアイコン をクリック

（１）ｳｨﾝﾄﾞｳを標準化し重ねる
　　ｳｨﾝﾄﾞｳを標準にして重ねます。
（２）ｳｨﾝﾄﾞｳを最小化
　　ｳｨﾝﾄﾞｳを最小化表示します。
（３）左右に並べて表示
　　ｳｨﾝﾄﾞｳを上下に並べます。
（４）上下に並べて表示
　　ｳｨﾝﾄﾞｳを左右に並べます。
（５）重ねて表示
　　ｳｨﾝﾄﾞｳを重ねて表示します。

（３）～（５）はExcel標準の整列機能と同等ですが、（１）（２）はオリジナル機能です。（２）は開いている複数のブックを全て最小化します。（１）は（２）で最小化したブックを重ねて表示しなおします。私がもっとも使用頻度が高いのは重ねて表示ですね。ウィンドウの作業スペースが狭くなるのがちょっと難点ですがブックタイトルが一望できて切り替えが容易になります。
よかったらご使用になってみてください。
E2000Toolsはこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

今回は前回に引き続き定型フォーマットのExcelを一気に作成するマクロを提示します。
前回の仕様を実装したものが以下となります。仕様の詳細はこちらhttp://peiyorin.cocolog-nifty.com/blog/2007/05/excel_vba_7a7b.htmlをご覧ください。

'申請書フォーマット
Const cWsNm As String = "申請書"
Const f_部署cel As String = "C2"
Const f_申請者cel As String = "C4"
Const f_承認者cel As String = "C6"
Const f_承認日cel As String = "C8"
Const f_機能名cel As String = "C10"
Const f_依頼事項cel As String = "C12"

'管理表
Const cStRow As Integer = 3
Const 部署col As Integer = 2
Const 申請者col As Integer = 3
Const 承認者col As Integer = 4
Const 承認日col As Integer = 5
Const 機能名col As Integer = 6
Const 機能詳細col As Integer = 7
Const 依頼事項col As Integer = 8
Const 申請日col As Integer = 9

Sub 申請書生成()
    Const cDefPath As String = "c:\work"
    Const cMyWs As String = "管理表"
   
    Set oMyWs = ThisWorkbook.Sheets(cMyWs)
    Set oFormWs = ThisWorkbook.Sheets(cWsNm)
   
   
    'フォルダ指定
    ChDrive Left(cDefPath, 1)
    ChDir cDefPath
    FileDir = Application.GetSaveAsFilename("DUMMY", "Excelﾌｧｲﾙ(*.xls),*.xls", , "■■■ 保存先ﾌｫﾙﾀﾞ指定 ■■■")
    If FileDir = "False" Or FileDir = "FALSE" Then Exit Sub
    FileDir = Mid(FileDir, 1, InStrRev(FileDir, "\") - 1)
   
   
    '申請書生成
    For Each oSel In Selection
        lRow = oSel.Row
        If oMyWs.Cells(lRow, 申請日col).Value <> "" Then GoTo next_oSel
       
        '申請書フォーマットコピー
        oFormWs.Copy
               
        '情報貼り付け
        Set oActWs = ActiveSheet
        a = oMyWs.Cells(lRow, 部署col).Value
        b = oMyWs.Cells(lRow, 申請者col).Value
        oActWs.Range(f_部署cel).Value = a
        oActWs.Range(f_申請者cel).Value = b
        oActWs.Range(f_承認者cel).Value = oMyWs.Cells(lRow, 承認者col).Value
        oActWs.Range(f_承認日cel).Value = oMyWs.Cells(lRow, 承認日col).Value
        oActWs.Range(f_機能名cel).Value = oMyWs.Cells(lRow, 機能名col).Value
        oActWs.Range(f_依頼事項cel).Value = oMyWs.Cells(lRow, 依頼事項col).Value
            
        oMyWs.Cells(lRow, 申請日col).Value = Now()
       
        ActiveWorkbook.SaveAs Filename:=FileDir & "\" & Format(Now(), "yyyymmddhhmmss") & "_" & a & "_" & b & ".xls"
       
next_oSel:
    Next

    Set oFormWs = Nothing
    Set oSel = Nothing
    Set oActWs = Nothing
    Set oMyWs = Nothing
   
End Sub

それでは解説していきます。
例のごとく、申請書用フォーマット、管理表の列番号やセル位置を定義してます。
モジュールですが、管理表シートおよび申請書フォーマットシートをオブジェクトにセットし、Application.GetSaveAsFilenameで申請書の保存先を指定するダイアログを表示します。デフォルトで表示するフォルダをcDefPathで定義しています。不要であれば削除してください。
For Each oSel In Selectionで予め選択した行数分処理を繰り返します。まず、処理対象行の申請日が空白でなければ処理を飛ばしています。これも無条件に申請書の再作成をする場合は削除してください。次に、申請書用フォーマットシートをコピーして、管理表の各項目を申請書の項目へ設定し、申請日に処理日を設定し、申請書を格納フォルダに保存して１件分の処理が完了です。
皆さんの仕事にあった形にカスタマイズしてご利用ください。
管理一覧.xlsをアップロードしておきますので、よかったらダウンロードしてみてください。

「kanri_sample.EXE」をダウンロード

以上で終了です。

次回から、私が作成したツールであるE2000Tools.xlsの機能について１日１つずつ１ヶ月くらいかけてご紹介していきます。きっと皆さんを便利にさせる機能があると思います。お楽しみに。ツール本体はこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

前回までの話題は「複数Ｅｘｃｅｌを開いて一覧表を作る」でしたが、今回からはその続きとして、申請者側の立場から、定型フォーマットのＥｘｃｅｌを一気に複数作成するマクロについて書いてみたいと思います。これは、ある管理情報があって、その情報を元に申請書フォーマットに項目を転記して、複数作成するような場合を想定しています。
つまり、各担当者は申請を作成する際に、いちいち雛形の定型フォーマットをコピーして、必要事項に手入力するという作業をやめて、予め申請に必要な情報を一覧として整備しておき、そこから必要に応じて申請書を一気に複数作成してしまおうという省力化マクロです。
一覧があるのならその一覧を渡せばいいじゃないかと疑問に思う方もいらっしゃると思いますが、取りまとめ者（部門）とのやり取りはとかく『定型のフォーマットで申請しないと受け付けません』とか、内部で管理している一覧は申請には不要な項目が含まれていたりするので『こんな一覧を各担当者から申請されても解りません』とか言われてしまうものです。

では、その申請書作成マクロですが、今回は以下の要領で考えてみたいと思います。
＜前提＞
（１）予め申請に必要な情報をまとめた管理表.xlsがある
（２）管理表.xlsには管理表シートとは別に、申請用フォーマットシートを保持している
（３）申請書作成マクロは管理表.xlsに実装するものとする

＜仕様＞
（１）管理表シートに実行ボタンを配置する
（２）作成したい行の任意のセルを複数選択した状態で､実行ボタンをクリックすることで処理を実行する
（３）生成された申請書.xlsの格納先フォルダを指定するダイアログを表示する
（４）選択した行の申請日がブランク（＝未申請）の場合、以下の（５）～（６）の処理を繰り返す
（５）申請用の新規ブックを作成し、申請用フォーマットシートをコピーする
（６）その新規ブックに対し、管理表シートから申請に必要な列の情報を流し込む
　　　上記（３）で指定した格納先フォルダに新規ブックを保存し、申請書作成済みのマークである”申請日”列に日付を設定する
　　　
仕様上、様々なインタフェースが考えられますが、読者の皆様の事情に応じていろいろ拡張してみてください。
格納先フォルダの指定が面倒であれば、プログラム内に保持しても良いし、申請日に関わらず再申請できるようにするなどが考えられると思います。申請用フォーマットは今回は処理を簡単にするために管理表.xlsのシートとして保持する仕様としましたが、フォーマットの変更を想定して、別ブックとして外出しにするのが現実的かもしれません。

それでは次回から実際のマクロを解説していきます。

第1回からだいぶ間隔が開いてしまいましたが第2回です。
少しおさらいをすると、各部門から申請された複数の申請書を一覧化しようというものでした。詳しくはこちらをご覧ください。http://peiyorin.cocolog-nifty.com/blog/2007/05/excel_vba_e3dc.html

前回の仕様をマクロにしたものが以下です。

'申請書フォーマット
Const f_部署cel As String = "C2"
Const f_申請者cel As String = "C4"
Const f_承認者cel As String = "C6"
Const f_承認日cel As String = "C8"
Const f_機能名cel As String = "C10"
Const f_依頼事項cel As String = "C12"

'申請書一覧
Const cStRow As Integer = 3
Const 部署col As Integer = 2
Const 申請者col As Integer = 3
Const 承認者col As Integer = 4
Const 承認日col As Integer = 5
Const 機能名col As Integer = 6
Const 依頼事項col As Integer = 7
Const 処理日col As Integer = 8
Const ファイル名col As Integer = 9
Const 更新日col As Integer = 10

Sub ファイル取り込み()
    Const cDefPath As String = "c:\work"
    Const cMyWs As String = "申請一覧"
   
    Set oMyWs = ThisWorkbook.Sheets(cMyWs)
   
    'クリア確認
    If vbYes = MsgBox("一覧をクリアしますか？", vbYesNo + vbQuestion, "クリア確認") Then
        lLastRow = oMyWs.Cells(65500, 部署col).End(xlUp).Row + 1
        oMyWs.Range(oMyWs.Cells(cStRow, 部署col), oMyWs.Cells(lLastRow, 更新日col)).ClearContents
    End If
   
    'フォルダ指定
    ChDrive Left(cDefPath, 1)
    ChDir cDefPath
    FileDir = Application.GetSaveAsFilename("DUMMY", "Excelﾌｧｲﾙ(*.xls),*.xls", , "■■■ ﾌｫﾙﾀﾞ指定 ■■■")
    If FileDir = "False" Or FileDir = "FALSE" Then Exit Sub
    FileDir = Mid(FileDir, 1, InStrRev(FileDir, "\") - 1)
   
   
    'ファイル情報取り込み
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getFolder(FileDir)
   
    For Each oF In f.Files
        If Not (IsNumeric(Left(oF.Name, 8))) Then GoTo next_oF
        If Not (oF.Name Like "*.xls") Then GoTo next_oF
       
        Workbooks.Open oF.Name, ReadOnly:=True
        Set oActWs = ActiveWorkbook.Sheets(1)
       
        lLastRow = oMyWs.Cells(65500, 部署col).End(xlUp).Row + 1
        oMyWs.Cells(lLastRow, 部署col).Value = oActWs.Range(f_部署cel).Value
        oMyWs.Cells(lLastRow, 申請者col).Value = oActWs.Range(f_申請者cel).Value
        oMyWs.Cells(lLastRow, 承認者col).Value = oActWs.Range(f_承認者cel).Value
        oMyWs.Cells(lLastRow, 承認日col).Value = oActWs.Range(f_承認日cel).Value
        oMyWs.Cells(lLastRow, 機能名col).Value = oActWs.Range(f_機能名cel).Value
        oMyWs.Cells(lLastRow, 依頼事項col).Value = oActWs.Range(f_依頼事項cel).Value
        oMyWs.Cells(lLastRow, 処理日col).Value = Now()
        oMyWs.Cells(lLastRow, ファイル名col).Value = oF.Name
        oMyWs.Cells(lLastRow, 更新日col).Value = oF.DateLastModified
            
        ActiveWorkbook.Close
       
next_oF:
    Next

    Set fs = Nothing
    Set f = Nothing
    Set oF = Nothing
    Set oActWs = Nothing
    Set oMyWs = Nothing
   
End Sub

ま、あくまでも一例であり、ロジックや実現手段はいろいろあるかと思います。
一応できるだけ汎用的にしたつもりです。それでは解説していきます。
まず、Constで定型フォーマットの入力セル位置を定義しています。ここは皆さんが使用されている定型フォーマットにあわせて修正してくださいね。次に申請書内容を一覧化する申請一覧の列番号を定義しています。後ほど、このマクロを実装した申請一覧をアップロードしますのでそちらをご覧になった方が一目瞭然でしょう。
さて、ロジック部分ですが、まず、マクロを実行する際に、申請一覧を一旦クリアするかどうかメッセージを表示させています。
次に、申請書が格納されているフォルダを指定するダイアログを表示します。実行するとわかるのですが、Application.GetSaveAsFilenameを流用しているのでファイル名に”DUMMY”がデフォルト表示されますが気にしないでください。ここの目的は格納先フォルダ名を取得することです。
次に、Set fs = CreateObject("Scripting.FileSystemObject")でFileSystemObjectオブジェクトを生成します。fsに対してGetFolderを実行して、指定されたフォルダ配下のファイルを全て取得します。For Each oF In f.Filesで取得したファイルに対して処理を繰り返していきます。まず、申請書ファイル名の規定であるyyyymmddのExcelファイル以外は処理を飛ばすように条件判断しています。先頭８文字が数字かという条件にしています。（日付か？というロジックが思い浮かばなくてごまかしています）
次に、条件に合致したファイルを開き、開いたExcelブックをoActWsオブジェクトとしています。申請一覧の最終行lLastRowを求め、申請書の入力項目を申請書一覧に貼り付け、開いた申請書を閉じて１件分終了という具合です。
申請書の入力項目以外に、管理情報として処理日、ファイル名、ファイル更新日も一覧化しています。
これで申請書を全て一覧化することができました。
申請書フォーマットと申請書一覧をカスタマイズすれば応用が利くでしょう。お試しください。

申請書一覧と申請書サンプル２ファイルを同梱しました。動作を確認してみてください。右クリックで「対象をファイルに保存」でダウンロードしてください。

sinsei_sample.EXE

次回は、申請者側の立場から、申請書を一気に複数生成するマクロについて書いてみたいと思います。

久しぶりのVBAネタです。
今日から数回に分けて、私の経験上いろいろな業種、部門で共通的に必要とされるのではと思われる話題として、複数の定型フォーマットブックを開いて一覧表を作るマクロについて書いてみたいと思います。
まず、ある担当者（ここは会社の社員でもよい）から取りまとめ者（部門でもよい）へ定型のExcelフォーマットを申請するというワークフローを想像してみてください。事務処理しかり、共通部品の申請しかり、各部署から特定の部署への作業依頼しかり、結構会社内もしくはプロジェクト内では一般的なフローではないでしょうか。
ここで、取りまとめ者（部門）の立場で考えてみます。大抵、取りまとめ者（部門）は申請されたExcelを開き、内容を確認し、正しければ何か処理をする、誤りがあれば申請元へ突返すといった流れですよね。申請Excelはそのまま保管でしょうか？取りまとめ者は受け取ったExcelをそのまま保管していても、内容を知るにはいちいちファイルを開かなければいけないので使い勝手が悪いですね。一覧化したくなりますね、うん。（話しの都合上ちょっと強引）

一覧化すれば、入力内容のチェックをマクロ化しておいてチェックを自動化したり、分析機能をマクロ化しておいて品質管理や統計分析などに利用することも可能になります。受け取った後の後続の処理へマクロで連動させることも考えられますね。
では、その一覧化マクロですが、今回は以下の要領で考えてみたいと思います。
＜前提＞
（１）申請されたExcelブックはある特定のフォルダに格納されている（固定とは限らない）
（２）申請されたExcelブックはファイル名が一定の基準に則っている（yyyymmdd_部署名_担当者名.xlsとする）
（３）申請されたExcelブックは当然同一フォーマットである
　　　入力項目はとりあえず以下としておく
　　　１　Ｂ列　　　    Ｃ列
　　　２　申請部署： ┏━┓
　　　３　　　　　　　　┗━┛
　　　４　申請者名： ┏━┓
　　　５　　　　　　　　┗━┛
　　　６　承認者名： ┏━┓
　　　７　　　　　　　　┗━┛
　　　８　承認日　 ： ┏━┓
　　　９　　　　　　　　┗━┛
　　 10　機能名　 ： ┏━┓
　　 11　　　　　　　　┗━┛
　　 12　依頼事項： ┏━━━━┓
　　　　　　　　         ┗━━━━┛

＜仕様＞
（１）予め一覧用ブックを用意し、その一覧用シートに実行ボタンを配置する
（２）処理をする前に、一覧をクリアするかどうかメッセージを表示
（３）格納フォルダを指定するダイアログを表示し、指定されたフォルダ配下の申請ブックの内、ある条件のものだけ１つずつ処理する
（４）申請されたExcelの入力内容は､一覧シートの最終行＋１行目に追加貼り付けし、終わったら申請ブックを閉じる
（５）上記（３）（４）を繰り返す

仕様上、様々なインタフェースが考えられますが、読者の方の事情に応じていろいろカスタマイズしてみてください。フォルダが固定なのであれば、マクロ内に持ってしまえばよりシンプルになりますし、拡張性は保持したいがフォルダ指定が面倒ということであれば、フォルダパスをシートのどこかに持っておくことでも良いと思います。また、指定フォルダ内のブックを無条件にすべて処理したり、一度申請済みの申請書が再度申請された場合は上書きするといった実務上必要な機能が出てきそうです。さらに、実行方法ですが、一覧用ブックを開いたらカスタムメニューが追加されたり、カスタムツールバーが追加されたりといろいろ考えられますね。

今回は申請フォーマットにExcelを想定していますが、Wordの場合も当然可能です。
Wordの例は今回は割愛しますが、一覧化するロジックが知りたいというご希望があれば書いてみたいと思います。

それでは次回から実際のマクロを提示して解説していきたいと思います。

今回はOutlookメールの添付ファイルを保存する機能について書いてみたいともいます。前回のカスタマイズ記事でカスタムメニューの画像を出していたのでネタばれだったかもしれませんね。

１つのメールに添付されているファイルを保存する機能は標準でありますね。メニュー「ファイル」→「添付ファイルの保存」→「すべての添付ファイル」です。でも複数メールの添付ファイルを一括保存する場合、あれっできない？Microsoftさん！？。。。

ということで作成したのが以下の処理です。

Sub 選択メールの添付ファイルを指定フォルダに一括保存()
    Dim cDir As String, oSel As Object, oF As Object
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim mySendFolder As Outlook.MailItem
    Dim myCopiedItem As Outlook.Items
    Dim lMax As Integer, i As Integer
    Dim MyTitle As String
    Dim Leng As Long, hWnd As Long, ret As Long
   
    Dim myAttachments As Outlook.Attachment
    Dim MsgTxt As String, a As String
    Dim myExlApp As Object, Files As Object
    Dim lSubject As String
   
    On Error Resume Next
    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    Set myExlApp = CreateObject("excel.Application")
    cDir = myExlApp.GetSaveAsFilename("DUMMY", "全ﾌｧｲﾙ(*.*),*.*", , "保存先フォルダ指定")
    If cDir = "False" Or cDir = "FALSE" Then GoTo p_exit
   
    cDir = Mid(cDir, 1, InStrRev(cDir, "\") - 1)
   
    '現在のｳｨﾝﾄﾞｳﾀｲﾄﾙ取得
    hWnd = GetActiveWindow()
    MyTitle = String(250, Chr(10))
    Leng = Len(MyTitle)
    ret = GetWindowText(hWnd, MyTitle, Leng)

    '選択されたﾒｰﾙの添付ﾌｧｲﾙを保存
    For Each oSel In myOlSel
        i = i + 1
        ret = SetWindowText(hWnd, oSel & "(" & i & "/" & myOlSel.Count & ")" & "を処理中...")
        For Each oF In oSel.Attachments
            oF.SaveAsFile cDir & "\" & oF.DisplayName
        Next
       
    Next
   
    ret = SetWindowText(hWnd, MyTitle)
    MsgBox "終了しました。総数：" & i
    ret = Shell("c:\windows\explorer.exe " & cDir, vbNormalFocus)

p_exit:
    Set myExlApp = Nothing
    Set oSel = Nothing
    Set oF = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
   
End Sub

解説すると、例のごとくSet myOlApp = CreateObject("Outlook.Application")でOutlookオブジェクトを作成し、Set myOlSel = myOlExp.Selectionで選択されているメールを取得します。Set myExlApp = CreateObject("excel.Application")でExcelのオブジェクトを生成し、ExcelのGetSaveAsFilename関数をフォルダ指定に流用しています。ここは"shell.application"のbrowseforfolderでも良いし他にもあるかもしれません。ちなみに、予めChDirをしたかったのですが、Outlookは有効にならないようです。For Each oSel In myOlSelで選択したメール分処理を繰り返します。さらに、For Each oF In oSel.Attachmentsでメールに添付された複数ファイル分処理を繰り返します。あとは、前回説明したタイトルバーの変更処理が含まれていますが割愛します。

以上が添付ファイルの一括保存についての説明でした。OutlookＶＢＡについては今回で終了とします。また、ネタが見つかったら書いてみたいと思います。

※私が作成したVBAツールです。よかったら使ってみてください。

今回はOutlookのタイトルバーを動的に変更してみます。
なぜタイトルバーを変更したいのかというと、ExcelはステータスバーにてApplication.StatusBar="ほげほげ"で変更できますが、Outlookは2007に至るまで出来ないようです（私が知らないだけかも）。私はよく、時間のかかる処理の場合、ステータスバーに進行状況を表示するのですが、Outlookはそれが出来ないじゃありませんか。そこで、ステータスバーの変わりにタイトルバーに進行状況を表示してしまえと考えたわけです。

しかし、前述のとおり簡単には変更できません。WindowsAPIを使用します。以下に例を示します。

    '現在のｳｨﾝﾄﾞｳﾀｲﾄﾙ取得
    hWnd = GetActiveWindow()
    MyTitle = String(250, Chr(10))
    Leng = Len(MyTitle)
    ret = GetWindowText(hWnd, MyTitle, Leng)

    '長い処理
    For Each oSel In myOlSel
        i = i + 1
        ret = SetWindowText(hWnd, oSel & "(" & i & "/" & myOlSel.Count & ")" & "を処理中...")

        内容省略。。。。

       
    Next
   
    ret = SetWindowText(hWnd, MyTitle)
    MsgBox "終了しました。総数：" & i

解説すると、GetWindowText関数で予め現在のタイトルバーの文言を取得しておきます。ウィンドウハンドルが必要なのでGetActiveWindow関数でアクティブウィンドウを取得します。次に長い処理の間にSetWindowText関数でタイトルバーに情報を設定します。上記は、複数選択されたメールを処理する際に”メール件名（分子/分母）”を表示させる例です。そして、最後に取得しておいたタイトルバーを元に戻して終了です。

変更されているタイトルバーの画像

WindowsAPIの宣言は以下の通り。

'アクティブウィンドウハンドルを取得する
Private Declare Function GetActiveWindow Lib "USER32" () As Long
'ウィンドウタイトル取得
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hWnd&, ByVal lpString$, ByVal cch&) As Long
''ウィンドウタイトル変更
Private Declare Function SetWindowText Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long

今回はここまでとします。結構簡単でしたね。次回のネタは未定です。それでは。

※私が作成したVBAツールです。よかったら使ってみてください。

今回はOutlook VBAのカスタマイズと配布方法について書いてみたいと思います。

前回は「Visual Basic Editor」のVbaProject.OTMに標準モジュールを追加して処理を記述して、マクロから実行したところまででしたね。それでは、Outlook VBAの処理を実行する方法として、２通りご紹介します。まずは標準ツールバーにアイコンを追加してマクロを割り当てて見ましょう。

ツールバーにアイコン追加画像

Outlookのツールバー上で右クリックし、「ユーザ設定」画面→「コマンド」タブのマクロを選択すると、前回作成した選択メールの情報をExcel一覧化が表示されているので、左ボタンでぐっとつかみツールバー上にドラッグ＆ドロップすればOKです。

この方法は自分だけでマクロを使う場合は良いですが、不特定多数の人に使用してもらうにはちょっとやっかいです。VBAマクロを配布するには、標準モジュールを「エクスポート」して.basファイルを作成し、他人に配布してから、配布した人間に上記のアイコン設定をしてもらわなければなりません。次に紹介するのはカスタムメニューの追加方法です。

Outlookメニューにカスタムメニュー追加画像

これを実現するには処理を書かなければなりません。私の記念すべき第１回目に書いたSub Application_Startup()に以下の処理を記述します。

    Const cMenu As String = "menu bar"
    Const cCtl1 As String = "Toolsﾒﾆｭｰ(&M)"
    Const cCtl2 As String = "選択メールの添付ファイルを指定フォルダに一括保存"
    Const cCtl3 As String = "下書きメールに添付ファイルを添付して送信トレイに一括格納"
    Const cCtl4 As String = "選択メールを一括送信"
    Const cCtl5 As String = "選択メールの情報をExcel一覧化"
    Const cCtl99 As String = "バージョン情報"
   
    Dim oExp As Outlook.Explorer
    Dim oBar As Office.CommandBar
   
    Set oExp = Outlook.ActiveExplorer
    Set oBar = oExp.CommandBars.Item(cMenu)
   
    For Each myControl In oBar.Controls
        If cCtl1 Like myControl.Caption & "*" Then
            myControl.Delete
        End If
    Next
    Set myControl = oBar.Controls.Add(msoControlPopup, , , 7, True)
               
    With myControl
        .Caption = cCtl1
       
        Set mySubControl = .Controls.Add(msoControlButton, , , , True)
        With mySubControl
           .Caption = cCtl2 & "(&H)"
           .FaceId = 721
           .Style = msoButtonIconAndCaption
           .Tag = cCtl2
           .Visible = True
           .OnAction = cCtl2
        End With
       
        Set mySubControl = .Controls.Add(msoControlButton, , , , True)
        With mySubControl
           .Caption = cCtl3 & "(&K)"
           .BeginGroup = True
           .FaceId = 3739
           .Style = msoButtonIconAndCaption
           .Tag = cCtl3
           .Visible = True
           .OnAction = cCtl3
        End With
       
        Set mySubControl = .Controls.Add(msoControlButton, , , , True)
        With mySubControl
           .Caption = cCtl4 & "(&S)"
           .FaceId = 2617
           .Style = msoButtonIconAndCaption
           .Tag = cCtl4
           .Visible = True
           .OnAction = cCtl4
        End With
       
        Set mySubControl = .Controls.Add(msoControlButton, , , , True)
        With mySubControl
           .Caption = cCtl5 & "(&E)"
           .BeginGroup = True
           .FaceId = 366
           .Style = msoButtonIconAndCaption
           .Tag = cCtl5
           .Visible = True
           .OnAction = cCtl5
       End With
      
        Set mySubControl = .Controls.Add(msoControlButton, , , , True)
        With mySubControl
           .Caption = cCtl99 & "(&A)"
           .BeginGroup = True
           .FaceId = 3998
           .Style = msoButtonIconAndCaption
           .Tag = cCtl99
           .Visible = True
           .OnAction = cCtl99
       End With
    End With

    Set oExp = Nothing
    Set oBar = Nothing
    Set myControl = Nothing
    Set mySubControl = Nothing
End Sub

ま、ちょっと余計な処理が含まれていますが気にしないでください。解説すると、Set oExp = Outlook.ActiveExplorerでOutlookオブジェクトを生成し、Set oBar = oExp.CommandBars.Item(cMenu)でメニューオブジェクトを生成します。以降はoBarに対してメニュー項目を追加していくというわけです。コマンド自体はExcelとほぼ同じですね。以上を実装すると、Outlookを起動すると画像のようなメニュー項目が追加されるようになり、そのメニューからマクロを実行することができます。で、配布方法ですが、C:\Documents and Settings\＠＠＠＠\Application Data\Microsoft\Outlook配下に存在するVbaProject.OTMファイルを配布し、配布先の上記フォルダに格納してもらえばよいわけです。ただし、少し注意が必要ですが、既に配布先PCでVBAマクロを作成したりしているとVbaProject.OTMファイルが存在していることになります。その場合は導入まえに退避してもらうなどの対処が必要になります。

このほかにも、メニューではなくカスタムツールバーを作成する方法などもありますが、ネットで探索してみてください。便利ツールもいくつか存在するみたいですので。

今回はここまでとします。次回はOutlookのタイトルバーをカスタマイズしてみます。

※私が作成したVBAツールです。よかったら使ってみてください。

VBAの話題は久しぶりになりますが、今回はOutlook VBAについて書いてみます。

OutlookでVBAってちょっとマイナーな気がしますが皆さんはいかがでしょうか？ネット上でも話題は少ない気がします。Outlookと自動化はあまり関係が無いような感じです。自分自身でもあまりアイデアがありません。

とっかかりとして、こんなことが出来るのだというところで、選択したメールの情報をExcelの一覧にしてみます。メールの内容をExcelで管理できるようになるので何かと便利です。以下がその例です。

Sub 選択メールの情報をExcel一覧化( )
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim MsgTxt As String, a As String
    Dim Files As Variant, oF As Variant
    Dim myExlApp As Object, oNewWb As Object, oSel As Object
    Dim i As Integer, j As Integer
    Dim lSubject As String
    Dim lMsg As String
    Dim lSentOnBehalfOfName As String
    Dim lSenderName  As String
    Dim lReceivedByName  As String
    Dim lReceivedOnBehalfOfName   As String
    Dim lReplyRecipientNames  As String
    Dim lTo  As String
    Dim lCC  As String
    Dim lBCC  As String
    Dim lCreationTime  As String
    Dim lSize  As Long
    Dim lsenderemailaddress  As String
    Dim lTempFile  As String
      
    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    '新規ﾌﾞｯｸ作成
    Set myExlApp = CreateObject("excel.Application")
    Set oNewWb = myExlApp.workbooks.Add
    '一覧整形
    myExlApp.ActiveWindow.Zoom = 85
    With oNewWb.sheets(1)
        .Cells.WrapText = True
       
        .Range("A1:N1") = Array("件名", "本文", "添付ﾌｧｲﾙ", "受信日時", "ｻｲｽﾞ", "送信者表示名", "送信者", "受信者表示名", "受信者", "", "TO", "CC", "BCC", "送信者Address")
        .Columns("A:A").ColumnWidth = 32
        .Columns("B:B").ColumnWidth = 40
        .Columns("D:D").ColumnWidth = 15.71
        .Columns("K:k").ColumnWidth = 15.71
        .Rows("2:2").Select
    End With
    myExlApp.ActiveWindow.FreezePanes = True
    With oNewWb.sheets(1)
        .Range("A1").Select
    End With
   
    i = 1
    '選択されているﾒｰﾙの添付ﾌｧｲﾙを保存
    For Each oSel In myOlSel
       
        lSubject = oSel.Subject
        lMsg = oSel.Body
        lSentOnBehalfOfName = oSel.SentOnBehalfOfName
        lSenderName = oSel.SenderName
        lReceivedByName = oSel.ReceivedByName
        lReceivedOnBehalfOfName = oSel.ReceivedOnBehalfOfName
        lReplyRecipientNames = oSel.ReplyRecipientNames
        lTo = oSel.To
        lCC = oSel.CC
        lBCC = oSel.BCC
        lCreationTime = oSel.ReceivedTime
        lSize = oSel.Size
        lsenderemailaddress = oSel.senderemailaddress
      
        lTempFile = ""
        For Each oF In oSel.Attachments
            lTempFile = lTempFile & oF.DisplayName & Chr(10)
            j = j + 1
        Next
       
        i = i + 1
       
        oNewWb.sheets(1).Cells(i, 1).Value = lSubject
        oNewWb.sheets(1).Cells(i, 2).Value = lMsg
        oNewWb.sheets(1).Cells(i, 3).Value = lTempFile
        oNewWb.sheets(1).Cells(i, 4).Value = lCreationTime
        oNewWb.sheets(1).Cells(i, 5).Value = Format(Int(lSize / 1024), "##,###") & "KB"
        oNewWb.sheets(1).Cells(i, 6).Value = lSentOnBehalfOfName
        oNewWb.sheets(1).Cells(i, 7).Value = lSenderName
        oNewWb.sheets(1).Cells(i, 8).Value = lReceivedByName
        oNewWb.sheets(1).Cells(i, 9).Value = lReceivedOnBehalfOfName
        oNewWb.sheets(1).Cells(i, 10).Value = lReplyRecipientNames
        oNewWb.sheets(1).Cells(i, 11).Value = lTo
        oNewWb.sheets(1).Cells(i, 12).Value = lCC
        oNewWb.sheets(1).Cells(i, 13).Value = lBCC
        oNewWb.sheets(1).Cells(i, 14).Value = lsenderemailaddress
       
    Next

    myExlApp.Visible = True
   
p_Error:
    Set oF = Nothing
    Set oSel = Nothing
    Set myExlApp = Nothing
    Set oNewWb = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
    MsgBox "終了しました。総数：" & i - 1
End Sub

では解説してみましょう。CreateObject("Outlook.Application")でOutlookオブジェクトを生成します。選択したメールをSet myOlSel = myOlExp.Selectionで取得します。

次にSet myExlApp = CreateObject("excel.Application")でExcelオブジェクトを生成します。For Each oSel In myOlSelで選択したメール１件ずつ繰り返し処理します。メールの情報は以下のものを取得しています。詳しくはVBAヘルプで確認してみてください。

    件名               oSel.Subject
    本文               oSel.Body
    受信日時         oSel.ReceivedTime
    ｻｲｽﾞ               oSel.Size
    送信者表示名   oSel.SentOnBehalfOfName
    送信者            oSel.SenderName
    受信者表示名   oSel.ReceivedByName
    受信者            oSel.ReceivedOnBehalfOfName
    TO                  oSel.To
    CC                 oSel.CC
    BCC               oSel.BCC
    送信者Address oSel.senderemailaddress

ざっくりこれが処理の説明ですが、ここから重要です。

この処理を何処に書けばよいでしょうか。Excelとほぼ同じですが、メニュー「ツール」→「マクロ」→「Visual Basic Editor」→VbaProject.OTMに標準モジュールを追加して処理を記述します。しかし、Excelはブック毎にVBAProjectが存在しますが、OutlookではVbaProject.OTMが唯一のプロジェクトです。

これでメニュー「ツール」→「マクロ」→「マクロ」→「選択メールの情報をExcel一覧化」で実行できるわけですが、実際に実行するとOutlook VBAに慣れていない方は多少驚きと煩わしさを感じることでしょう（始めは私もそうでした）。それは、セキュリティの問題です。昨今のウィルスによるメール大量送付は大抵このVBAや親戚（？）のWSHによるものなので、VBAを実行するといちいち以下のような防御のメッセージが表示されます。「アクセスを許可する時間」で指定した時間内はかろうじてVBA処理が許可されるしくみです。最大１０分まで選択できるので選択して「はい」で実行することができます。

長くなりましたので今回はここまでとします。次回はOutlookのカスタマイズと配布方法について書いてみます。

※私が作成したVBAツールです。よかったら使ってみてください。

今回はExcelをカスタマイズするシリーズの本当の最終回とします。

前回はちょっと前置きが長くなりましたが、要はExcelを起動したときに前回保存したウィンドウの状態を再現し、タスクバーに隠れないようにウィンドウを自動的に移動するということになります。前回書き忘れましたが、実はこのウィンドウ位置を自動調節してくれるフリーソフトは存在します（名前は忘れましたが）。以前私も使用していましたが、なぜか使用しなくなりました。わざわざソフトを常駐させておきメモリーを消費するのがいやになったからかもしれませんが理由は覚えていません。

さて、ここからが本題です。前回の処理の概略に沿って説明します。

    （１）自分好みに調節したExcelウィンドウの縦横サイズと表示座標を取得する

    （２）Excel終了時に（１）の情報を保存する（保存先はレジストリでも良いが手軽なiniファイルへの保存を採用することとする。WindowAPI関数が必要）

      この（１）、（２）の処理の例は以下の通り

        lngWindowHandle = FindWindow("XLMAIN", vbNullString)
       
        If lngWindowHandle = 0 Then Exit Sub
            
        With Application
            If .WindowState = xlMinimized Then
                .WindowState = xlNormal
            End If
            lrc = GetWindowRect(lngWindowHandle, lpRect)
            If lrc = 0 Then
                Exit Sub
            End If
        End With
       
        With lpRect
            lVal = _
                    gEt_Left & "=" & .Left & vbNullChar & _
                    gEt_Top & "=" & .top & vbNullChar & _
                    gEt_Right & "=" & .Right - .Left & vbNullChar & _
                    gEt_Bottom & "=" & .Bottom - .top & vbNullChar & vbNullChar
        End With
        Call WritePrivateProfileSection(gSc_ExcelWindowSize, lVal, "iniファイルパス")

       解説ですが、GetWindowRect関数で現在のウィンドウ位置を取得するのですが、ウィンドウハンドルを必要としますのでFindWindowで取得します。WritePrivateProfileSectionでiniファイルに書き込みをします。当然以下をモジュールの先頭に記述しておく必要があります。これらの処理をWorkbook_BeforeCloseから呼び出せばよい訳です。

       Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
           ByVal lpszClass As String, ByVal lpszWindow As String) As Long

        Private Declare Function GetWindowRect Lib "user32" _
            (ByVal hWnd As Long, _
            lpRect As RECT) As Long

       Public Declare Function WritePrivateProfileSection Lib "kernel32" _
             Alias "WritePrivateProfileSectionA" _
             (ByVal lpAppName As String, _
             ByVal lpString As String, _
             ByVal lpFileName As String) As Long

    （３）Excel起動時にiniファイルから情報を取得する

    （４）取得したウィンドウ位置などを設定する（当然これもWindowsAPI関数）

       （３）、（４）の処理については以下の通り。

        lngWindowHandle = FindWindow("XLMAIN", vbNullString)

        If lngWindowHandle = 0 Then Exit Sub
            
        rtn = m_GetSecIni(pIniNm, gSc_ExcelWindowSize, larr)
        If rtn = False Then Exit Sub
       
        For i = LBound(larr) To UBound(larr)
            Select Case larr(i)(0)
            Case gEt_Left
                lngMoveLeft = larr(i)(1)
            Case gEt_Top
                lngMoveTop = larr(i)(1)
            Case gEt_Right
                lngMoveRight = larr(i)(1)
            Case gEt_Bottom
                lngMoveBottom = larr(i)(1)
            End Select
        Next

        lngWin32apiResultCode = _
            MoveWindow(lngWindowHandle, _
                       lngMoveLeft, _
                       lngMoveTop, _
                       lngMoveRight, _
                       lngMoveBottom, _
                       True)

       Thisworkbookに記述したWorkbook_openから上記の処理を呼び出すことで実現できます。m_GetSecIniでは、GetPrivateProfileSection関数を呼んで、iniファイルの指定セクションに含まれるキーの値を一括取得しています（詳細は割愛します、ネット上にたくさん例がありますので）。iniファイルには以下の通り記述されていて、ExcelWindowSizeセクションの情報を一括取得するわけです。そして、MoveWindow関数で前回保存した値でExcelのウィンドウ位置を変更します。必要な宣言は以下の通り。

          [ExcelWindowSize]
            Left=50
            Top=0
            Right=973
            Bottom=767

        Private Declare Function MoveWindow Lib "user32.dll" _
               (ByVal hWnd As Long, _
                ByVal x As Long, _
                ByVal y As Long, _
                ByVal nWidth As Long, _
                ByVal nHeight As Long, _
                ByVal bRepaint As Long) As Long
       
        Public Declare Function GetPrivateProfileSection Lib "kernel32.dll" _
                Alias "GetPrivateProfileSectionA" _
                (ByVal lpAppName As String, ByVal lpReturnedString As String, _
                ByVal nSize As Long, ByVal lpFileName As String) As Long

いやぁ～長くなりましたが以上で実現できます。

これらの処理を記述したExcelブックをMS-OfficeがインストールされているフォルダにあるＸＬＳｔａｒｔに格納しておけば、Excelを毎回起動する度に前回保存状態を再現してくれるようになります。Excelブックは非表示状態にしておくと邪魔にならず良いでしょう。お試しあれ。

さて、Ｅｘｃｅｌのカスタマイズシリーズは一旦終了とします。また、ネタが見つかったら書き込んでみたいと思います。それでは。

※私が作成したVBAツールです。よかったら使ってみてください。

今回はExcelをカスタマイズするシリーズの第６弾（最終回）、Excel起動時に前回終了ウィンドウ状態を再現について述べたいと思います。

ちょっと話しが脱線しますが、私はWindowsXPを使用しているのですが、タスクバーを左側にして利用しています。もともとパソコンを使い始めたころから、Excelなどのソフトのメニューは上部にあるのにタスクバーが下にあるとマウスの移動が大きく面倒だなと不満を感じていたので上部にして使用していました。あるとき、同僚が左側にしているのを見たのをきっかけに左側にして使用するようになりました。初めは「え～変わった使い方だなぁ」と思ったのですが、よくよく自分の使い方を考えてみると、上部だとタスクバーの利用と、ソフトのメニューの利用ととても接近していて便利なのですが、ソフトの縦の情報がタスクバーの高さ分だけ減少してしまいます（ノートPCの利用が多いので上下の数行は貴重）。どちらかというと、上下よりも左右の情報（特に右側）は必要度が低いのでタスクバーを左側に持ってくれば上下の情報が少しでも稼げると感じました。タスクバー上のボタンも、ソフトのメニューも適度に近いし慣れると結構快適であると感じています。

ということで長々と書いてきましたがタスクバーを左側に置くと、最もよく使うExcelで１点弊害が出てきました。それは、Excelを起動すると必ず左端に開くということです。つまり、Excelの一部がタスクバーの裏に隠れてしまうのです。タスクバーの設定で、「常にほかのウィンドウの手前に表示する」というのがありますが、この設定にしてもダメです。Excelを最大化しておけば大丈夫なのですが、理由があって最大化したくないのです。

このように隠れてしまう弊害を解消するために、ウィンドウのサイズと表示位置を保存しておき、次回起動時にそれを再現するという機能をExcelに持たせればよいと考えました。

これを実現するためには以下のワザを駆使する必要があります。

    （１）自分好みに調節したExcelウィンドウの縦横サイズと表示座標を取得する（WindowsAPI関数を利用する必要有り）

    （２）Excel終了時に（１）の情報を保存する（保存先はレジストリでも良いが手軽なiniファイルへの保存を採用することとする。WindowAPI関数が必要）

    （３）Excel起動時にiniファイルから情報を取得する（これもWindowAP関数I）

    （４）取得したウィンドウ位置などを設定する（当然これもWindowsAPI関数）

以上が処理の概略です。

ちょっと前置きというか脱線というかVBAの説明に入る前の話しが長くなったので今回はここまでとします。次回が本当の最終回ということで。。。 それでは。

※私が作成したVBAツールです。よかったら使ってみてください。

本日は第５弾として、タイトルバーの動的な変更です。

タイトルバーの変更自体は難しいことではありません。以下の命令で変更できます。flgによってタイトルバーの変更／戻しを実行する例です。

    If flg = False Then
        Application.Caption = ""                      ’タイトルバーの戻し
    Else
        Application.Caption = "ほげほげ"         ’タイトルバーの変更
    End If
   

しかし、わざわざ”動的”と謳っているのは意味があります。

皆さんはブックを開いたあとでこのブックはどこのフォルダから開いたファイルだったかなぁと思ったことはありませんか？

そこで、今アクティブにしているブックのパスをタイトルバーに表示することを考えました。

つまり複数ブックを開いて作業しているときに、アクティブにしたブックのパスを動的に表示するわけです。

これを実現するにはクラスモジュールを用意しなければなりません。

ちょっと高度ですが、なにも考えず以下の手順で作成してみてください。（５）はパスだけではなくファイルサイズも表示する例です。

（１）処理を記述するためのブックを新規作成する。

（２）VBEのVBAProject上で右クリックをし、「挿入」→「クラスモジュール」を選択する

（３）Thisworkbook に Dim Aw As New Class1 を記述する

（４）Thisworkbook に 以下のWorkbook_openを追加する

     Private Sub Workbook_open()
         Set Aw.App = Application
     End Sub

（５）（２）で作成したClass1に以下の処理を記述する

    Private Sub App_WindowActivate(ByVal wb As Excel.Workbook, ByVal Wn As Excel.Window)
        If wb.Path = "" Then
            Application.Caption = ""
        Else
            Application.Caption = "Microsoft Excel " & wb.FullName & " (" _
                        & Format(FileLen(wb.FullName), "###,##0") & "Byte" & ")"
        End If
    End Sub

（６）一旦新規ブックを保存し、Excelと新規ブック共に再起動するとあら不思議、複数ブックをアクティブにしていくとタイトルバーが動的に変化します。よね？変化すれば完成です。今回作成した新規ブックは非表示にしておくと良いでしょう。邪魔にならないので。

少し解説すると、（３）（４）はおまじないだと思ってください。深く知りたい方はVBAヘルプでまず「Application オブジェクトでイベントを使用する」を検索していろいろ読み進めていってください。ネット上にもたくさん解説ページがあります。

次に、処理本体の（５）ですが、App_WindowActivateというExcel標準のクラスイベントを定義しています。これはウィンドウがアクティブになった時に発生するExcelが予め持っているイベントです。ここに処理を書いておくことで今回の目的を実現しています。さらにwbはアクティブになったブックオブジェクトが渡されますので処理に利用しています。If wb.Path = "" Thenは、一度も保存されていないブックがアクティブにされたことを想定しています。つまり、保存されていないのでパスが取得できないわけです。

実はこのイベントだけでは、Excelで作業をしていく上でいろいろ不都合が発生します。例えば、書き換えたタイトルバーの初期化（＝戻し）の問題です。ま、これは他にもクラスイベントがあるのでそれらを参考に作成してみてください。

以上でタイトルバーの動的変更についての説明はおしまいです。ちょっと難しかったですがクラスイベントは自分で作成することが出来て、Excelを拡張する手段として奥が深いので研究してみてはいかがでしょうか。

次回は、Excel起動時に前回終了ウィンドウ状態を再現について。

※私が作成したVBAツールです。よかったら使ってみてください。

本日は第４弾として、カスタムツールバーの作成方法です。

カスタムツールバーとは自分で作成するツールバーのことです。

例えば、Excelには標準で”標準”や”書式設定”、”図形描画”

などがありますね。これらのツールバー以外に自分用に作成する

ことができます。

以下は、VBAから動的に作成する例です。

Set myBar = CommandBars.Add(Name:="ボタンの変更", Position:=msoBarTop, _
    Temporary:=True)
myBar.Visible = True

もちろんアイコンボタンに処理を割り当てて自分用のツールバー

を作成できるのですが、アイコンが登録済みのものしか利用できないので

私は次の別の方法を採用しています。

ツールバーの上で右クリックをし「ユーザ設定」

を選択すると、「新規作成」ボタンがありますがそれを実行すると

新しいツールバーを作成することができます。

次に、コマンドタブのマクロでユーザー設定ボタンをツールバーに

ドラッグ＆ドロップすればボタンを追加することが出来ます。

次に、ボタンの上で右クリックしボタンイメージの編集で自由に

アイコンを変更できます。こうしてボタンを追加していけば

自分用のツールバーが出来上がります。

では、このツールバーをブックに割り当てるにはどうしたら

良いでしょうか？

先ほどの「ユーザー設定」画面にある「添付」をクリックし、

コピーすればツールバーをアクティブブックに登録すること

ができます。

さらに、そのブックのThisworkbookに以下の処理を追加します。

Private Sub Workbook_open()

    '自分自身ﾂｰﾙﾊﾞｰ表示
    Application.CommandBars("ツールバー名").Visible = True
   

end sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next

    'ツールバーを削除
    Application.CommandBars("ツールバー名").DELETE
End Sub

これでツールバーの表示・非表示の制御が完成です。

以上でツールバーの作成方法の説明はおしまいです。お試しください。

次回はちょっと高度な、動的なタイトルバーの変更について

※私が作成したVBAツールです。よかったら使ってみてください。

本日は第３弾として、シートタブメニューのカスタマイズ方法です。

シートタブメニューとは私が勝手に呼んでいるのですが、例えば

Sheet1のタブ上で右クリックした時に表示されるメニューです。

デフォルトでは”挿入”や”名前の変更”などがありますよね。

これをVBAマクロで変更することが出来ます。

例えば以下の通りです。

フラグによって、メニュー項目の追加と削除を行う例です。

右クリックメニュー変更の応用ですが、CommandBars("Ply")

CommandBarsのうち、"Ply"がExcelが内部管理している

シートタブメニューの名称です。詳細はVBAのヘルプをご覧ください。

        'ｷｰ割当て
        If pFlg Then
            Set Newb = Application.CommandBars("Ply").Controls.Add
            With Newb
                .Caption = "アクティブシートを非表示にする"
                .OnAction = "m_シート非表示"
                .FaceId = 2587
            End With
        Else
            For Each oCb In Application.CommandBars("Ply").Controls
                If oCb.Caption = "アクティブシートを非表示にする" Then
                    oCb.DELETE
                End If
            Next oCb
        End If

次回はカスタムツールバーについて。

※私が作成したVBAツールです。よかったら使ってみてください。

本日は第２弾として、ショートカットキーのカスタマイズ方法です。

ショートカットキーとは例えばCtrlキー＋Sでブックの上書き保存

など、キーボード操作を便利にする機能ですね。

これをVBAマクロで変更することが出来ます。

例えば以下の通りです。

フラグによって、キー割り当てと割り当て解除を行う例です。

Ctrl+aで処理名を実行する例ですが詳細はVBAのヘルプをご覧ください。

        lOnKey = "^{a}"

        lMacro = "処理名"

        If pFlg = True Then
            Application.OnKey lOnKey, lMacro    'キー割り当て
        Else
            Application.OnKey lOnKey            'キー解除
        End If

次回はシートタブメニューについて。

※私が作成したVBAツールです。よかったら使ってみてください。

今日からExcelカスタマイズ特集をしてみよう。

本日は第1弾として、右クリックメニューのカスタマイズ方法です。

右クリックメニューとは任意のセル上でマウスの右クリックをした

時に表示されるメニューです。

これをVBAマクロで変更することが出来ます。

例えば以下の通りです。

フラグによって、メニューの追加と削除を行う例です。

いくつかポイントがありますが、まず、

"Cell", "Column", "Row"はExcelが内部管理している

メニューの種類です。セル上のメニュー、列選択したときのメニュー

、行選択したときのメニューということです。

次に、Controls.Add(type:=msoControlButtonですが、ボタン形式

のメニューということです。さらに、そのアイコンはFaceIdの番号

で指定します。詳細はVBAのヘルプをご覧ください。

For Each oCb In Application.CommandBars
      Select Case oCb.Name
      Case "Cell", "Column", "Row"
            With oCb
                    If pFlg = True Then
                        'ｷｰ割当て
                        With .Controls.Add(type:=msoControlButton, id:=266, Temporary:=True)
                            .Caption = "処理名（メニュー名）"
                            .OnAction = "m_処理"
                            .BeginGroup = True
                            .FaceId = 496
                        End With
                    Else
                        'ｷｰ割当て解除
                        For Each oCc In .Controls
                            If oCc.Caption = "処理名（メニュー名）" Then
                                oCc.DELETE
                            End If
                        Next
                    End If
           End With
      End Select
Next oCb

次回はショートカットキーについて。

※私が作成したVBAツールです。よかったら使ってみてください。

ブログデビューしました。

何をはじめに書こうかちょっと悩みましたがすぐに決まりました。

ブログを始める理由はこれだからです。

つまりVBAの裏ワザなどネットで仕入れ＆応用したものを公開した

マイページを補完することです。

マイページは追々公開していこうと思います。

でも１発目のネタは悩みますね、記念すべき最初のネタですからね。

うむむ。。。

無難なところで、ファイルを開いたと同時にVBAを実行する方法にしよう。

以下を実装すればOKです。お試しあれ。

●Excelの場合

Sub Workbook_open()をVBAProjectのThisworkbookに作成すればよい。

●Outlookの場合

Sub Application_Startup()をVBAProject.OTMのThisOutlookSessionに作成すればよい。

※私が作成したVBAツールです。よかったら使ってみてください。