巨人の肩の上に立つ

[アーティクル]
03/18/2008

David Shank
Microsoft Corporation

2000 年 7 月 6 日

今月のコラムのタイトルはアイザックニュートン卿の言葉を引用したものです。ニュートンは彼自身の偉業について意見を求められたときに、すぐさま心からの謙遜の意を込めてこう答えました。「もし私が他の人よりも遠くを見ているとしたら、それは巨人の肩の上に立っているからだ」

この言葉は非常に興味深いものですが、それと Office を使ったカスタムソリューションの作成と何の関係があるのか疑問に思われるでしょう。関係は大ありです。ニュートンが言いたかったことは、自分の偉業がどんなに華々しいものであろうと、それは先哲の偉業の上に成り立っているのだということです。開発者は他人が作ったものを「流用する」という悪名を背負っていますが、そのことは決して間違ったことではなく、実際非常に大きな意義があるのです。MSDN 自体が掲げている基本的な原則の 1 つに、他人が記述した情報やサンプルコードを提供してそれを利用してもらう、ということがあります。MSDN のスタッフは、コードの書き方を覚えるには、その書き方を読むだけという方法より、いくつかのよいサンプルコードを提供して実際に見てもらうよいと考えています。

他人が記述したコードを使って Office のプログラミングについて詳しく学習するだけにとどまらず、コードそのものを自分のカスタムソリューションの中で利用できれば理想的です。問題は、有益なコードサンプルを収集、蓄積するために何らかの組織立てた方法を考えるということです。別の見方をすれば、後で再利用できるように自分自身のコードを蓄積する手段を考えるということでもあります。開発者は、コードの収集と保存、そして再利用のためにコードを蓄積する方法について、さまざまな手段を持っています。たとえば、高度なコード管理アプリケーションを購入するといった方法から、お気に入りのルーチンをテキストファイルにコピーしてディスクに保存するといった方法まであります。

繰り返し必要になることがわかっているようなプロシージャやコードなどを蓄積しておける、検索が可能な 1 個のコードレポジトリ（貯蔵庫）を用意しておけば、いかに便利か想像してみてください。さらに、そのレポジトリに、すぐに使えるプロシージャが無数に蓄積されていたとしたらどんなに便利なことでしょう。

市販されている良質なコードライブラリを購入したり、あるいは自分でコードライブラリを作成するという方法もありますが、Microsoft Office Developer（https://www.microsoft.com/office/developer/）をお持ちの方は既に良質なコードライブラリが手元にありますから、これを活用しない手はありません。このコードライブラリには多数のサンプルコードが付属しており、自分のカスタムソリューションの中で利用できます。

今月のコラムでは、Microsoft Office Developer（MOD）で利用できるコードライブラリアンアドインについて解説します。今回は実際のコードライブラリアンからいくつかのコードサンプルを抜粋して紹介しており、MOD を持っていない方にも有益な内容だと思います。これらのコードサンプルはコピーしてそのまま自分のカスタムソリューションの中で利用できます。

コードライブラリアンとは

MOD に付属の COM アドインであるコードライブラリアンは、コードモジュールや関数、コードなどの蓄積と取得をドラッグアンドドロップで行えるデータベースです。MOD コードライブラリアンには、サンプルコードがあらかじめ登録されており、それらを自分の Office ソリューションの中でそのまま利用できます。また、自分のサンプルコードをデータベースに追加することでコードライブラリアンをカスタマイズすることもできます。さらに、ほかの Office 開発者製品（https://msdn.microsoft.com/office/default.asp）でもコードライブラリアンを使ったサンプルコードが配布されており、最新のものでは Microsoft Visio ソリューションを扱ったサンプルコードが収められています。

注意： コードライブラリアンを使わずにソースデータベース内のコードにアクセスすることはできません。

MOD をインストールしたあと、MOD を開くには先にアドインをロードする必要があります。

任意の Office アプリケーションから Visual Basic Editor（VBE）を開きます。
VBE の［アドイン］メニューから［アドインマネージャ］コマンドをクリックします。
利用可能なアドインの一覧から［コードライブラリアン］を選択します。
［ロードする / ロードしない］チェックボックスをオンにしてから［OK］をクリックし、［アドインマネージャ］ダイアログボックスを閉じます。
VBE の［アドイン］メニューを開き、［コードライブラリアン］コマンドをクリックします。

コードライブラリアンでは、Windows エクスプローラに似たインターフェイスの中でサンプルコードが整理されています。左側のペインにはメインのコードカテゴリが表示され、右側のペインには個々の関数、サブルーチン、モジュール、およびクラスモジュールが表示されます。プロシージャの説明は右側のペインの下にあるメッセージ領域に表示されます。

概観図 1：コードライブラリアン

プロシージャをダブルクリックすると、そのプロシージャが別のウィンドウに表示されます。たとえば、次の画面は LastDayOfMonth プロシージャをダブルクリックした結果です。

概観図 2：プロシージャの表示

コードライブラリアンではドラッグアンドドロップ形式の編集がサポートされています。このため、プロシージャをコードライブラリアンからドラッグしてプロジェクトにドロップすることで、プロシージャをプロジェクトに追加できます。同様に、自分のプロシージャを強調表示にしてコードライブラリアンまでドラッグすることで、自分のプロシージャをコードライブラリアンに追加できます。

MOD コードライブラリアンは、自分のプロシージャやほかの人からコピーしたプロシージャを手軽に蓄積して分類することのできる便利なツールです。また、コードライブラリアンの使用するかどうかは別として、再利用しやすいコードを書く習慣を身に付けておくことは、とてもよいことです。詳細については、「再利用可能なコードを作成する」を参照してください。

サンプルコードのサンプル

ここではコードライブラリアンの中からわずかなサンプルコードしか紹介することができません。これらは、コードライブラリアンに含まれている再利用可能なコードの例として示すものであり、再利用可能なプロシージャの書き方を示す例でもあります。どのサンプルコードもこのコラムからコピーしてそのまま自分の Office ソリューションの中で利用できます。

日付と時刻の例

人の年齢の計算：

  Function Age(Bdate, DateToday) As Integer
'
' Returns the Age in years between two dates
' Doesn't handle negative date ranges, i.e. Bdate> DateToday
'
  If Month(DateToday) <Month(Bdate) Or (Month(DateToday) = Month(Bdate) And Day(DateToday) <Day(Bdate)) Then
    Age = Year(DateToday) - Year(Bdate) - 1
  Else
    Age = Year(DateToday) - Year(Bdate)
  End If
End Function

文字列値から日付値への変換：

  Function String2Date(S, Fmt As String)
'
' Converts strings to dates depending on Fmt
' See Help on Format for what the various strings mean
' Comments use 27 May, 1993, as example date to show input text
'
  If VarType(S) <> 8 Then
    String2Date = Null
    Exit Function
  End If
  Select Case Fmt
    Case "MMDDYY", "MMDDYYYY"          '052793   05271993
      String2Date = CVDate(left(S, 2) & "/" & Mid(S, 3, 2) & "/" & Mid(S, 5))
    Case "DDMMYY", "DDMMYYYY"          '270593   27051993
      String2Date = CVDate(Mid(S, 3, 2) & "/" & left(S, 2) & "/" & Mid(S, 5))
    Case "YYMMDD"          '930527
      String2Date = CVDate(Mid(S, 3, 2) & "/" & Right(S, 2) & "/" & left(S, 2))
    Case "YYYYMMDD"          '19930527
      String2Date = CVDate(Mid(S, 5, 2) & "/" & Right(S, 2) & "/" & left(S, 4))
    Case "MM/DD/YY", "MM/DD/YYYY", "M/D/Y", "M/D/YY", "M/D/YYYY", "DD-MMM-YY", "DD-MMM-YYYY"
      String2Date = CVDate(S)
    Case "DD/MM/YY", "DD/MM/YYYY"          '27/05/93   27/05/1993
      String2Date = CVDate(Mid(S, 4, 3) & left(S, 3) & Mid(S, 7))
    Case "YY/MM/DD"          '93/05/27
      String2Date = CVDate(Mid(S, 4, 3) & Right(S, 2) & "/" & left(S, 2))
    Case "YYYY/MM/DD"          '1993/05/27
      String2Date = CVDate(Mid(S, 6, 3) & Right(S, 2) & "/" & left(S, 4))
    Case Else
      String2Date = Null
  End Select
End Function

ある月の特定の日の検索：

  Function FirstOfNextMonth(Optional dteDate As Date) As Date

    If CLng(dteDate) = 0 Then
        dteDate = Date
    End If

    FirstOfNextMonth = DateSerial(Year(dteDate), Month(dteDate) + 1, 1)
End Function

Function LastOfPreviousMonth(Optional dteDate As Date) As Date

    If CLng(dteDate) = 0 Then
        dteDate = Date
    End If

    LastOfPreviousMonth = DateSerial(Year(dteDate), Month(dteDate), 0)

End Function

コマンドバーとメニューの例

コマンドバーの作成：

  Function CBCreateCommandBar(strCBarName As String, _
                            Optional lngBarType As Long = 0) As CommandBar

    ' This procedure creates a command bar of the type
    ' specified in the lngBarType argument. The default
    ' command bar type is a toolbar.

    Dim cbrCmdBar   As CommandBar
    Dim strBarType  As String
    Dim lngPosition As Long

    On Error Resume Next
    Set cbrCmdBar = Application.CommandBars(strCBarName)
    If Err = 0 Then
        ' The command bar already exists.
        If cbrCmdBar.BuiltIn = True Then
            CBCreateCommandBar = False
            Exit Function
        End If

        strBarType = CBGetCBType(cbrCmdBar)

        If MsgBox("'" & strCBarName & "' is an existing " & strBarType _
            & " type command bar. Are you sure you want to delete it?", vbYesNo, _
            "Replace Existing Command Bar?") = vbNo Then
            CBCreateCommandBar = False
            Exit Function
        Else
            cbrCmdBar.Delete
            Set cbrCmdBar = Nothing
        End If
    Else
        ' The command bar does not exist, so reset the error number to zero
        ' and create the new command bar.
        Err = 0
    End If
    If lngBarType <> msoBarMenuBar And lngBarType <> msoBarPopup Then
        lngBarType = msoBarTypeNormal
    End If

    Select Case lngBarType
        Case msoBarTypeNormal
            Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName)
        Case msoBarMenuBar
            Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarMenuBar) ', , 'True)
        Case msoBarPopup
            Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)
    End Select

    Set CBCreateCommandBar = cbrCmdBar
End Function

コマンドバーのコピー：

  Function CBCopyCommandBar(strOrigCBName As String, _
                          strNewCBName As String, _
                          Optional blnShowBar As Boolean = False) As Boolean

    ' This procedure copies the command bar named in the strOrigCBName
    ' argument to a new command bar specified in the strNewCBName argument.

    Dim cbrOriginal         As CommandBar
    Dim cbrCopy             As CommandBar
    Dim ctlCBarControl      As CommandBarControl
    Dim lngBarType          As Long

    On Error GoTo CBCopy_Err

    Set cbrOriginal = CommandBars(strOrigCBName)

    lngBarType = cbrOriginal.Type
    Select Case lngBarType
        Case msoBarTypeMenuBar
            Set cbrCopy = CommandBars.Add(Name:=strNewCBName, Position:=msoBarMenuBar)
        Case msoBarTypePopup
            Set cbrCopy = CommandBars.Add(Name:=strNewCBName, Position:=msoBarPopup)
        Case Else
            Set cbrCopy = CommandBars.Add(Name:=strNewCBName)
    End Select

    ' Copy controls to new command bar.
    For Each ctlCBarControl In cbrOriginal.Controls
        ctlCBarControl.Copy cbrCopy
    Next ctlCBarControl

    ' Show new command bar.
    If blnShowBar = True Then
        If cbrCopy.Type = msoBarTypePopup Then
            cbrCopy.ShowPopup
        Else
            cbrCopy.Visible = True
        End If
    End If
    CBCopyCommandBar = True
CBCopy_End:
    Exit Function
CBCopy_Err:
    CBCopyCommandBar = False
    Resume CBCopy_End
End Function

コマンドバーからコントロールを削除：

  Function CBDeleteCBControl(strCBarName As String, _
                           strCtlName As String)

    On Error Resume Next
    Application.CommandBars(strCBarName).Controls(strCtlName).Delete
End Function

コマンドバーコントロールの表示 / 非表示の切り替え：

  Function CBCtlToggleVisible(strCBarName As String, _
                            strCtlCaption As String) As Boolean

    ' Toggle the Visible property of the strCtlCaption control
    ' on the strCBarName command bar.

    Dim ctlCBarControl As CommandBarControl

    On Error Resume Next

    Set ctlCBarControl = Application.CommandBars(strCBarName).Controls(strCtlCaption)
    ctlCBarControl.Visible = Not ctlCBarControl.Visible
    If Err = 0 Then
        CBCtlToggleVisible = True
    Else
        CBCtlToggleVisible = False
    End If
End Function

文字列の操作

文字列の一部の削除：

  Function RemoveString(ByVal strSource As String, _
                      strStart As String, _
                      strEnd As String, _
                      Optional intEndCount As Integer = 0, _
                      Optional blnReturnChunk As Boolean = False) As String

    ' Remove the string from strSource beginning at
    ' the start of strStart and ending at the end of
    ' strEnd.
    ' Return the new string to the calling procedure.
    ' If any of the input parameters are invalid, then return
    ' a zero-length string.

    Dim intStartPos     As Integer
    Dim intEndPos       As Integer
    Dim strStartPiece   As String
    Dim strEndPiece     As String

    intStartPos = InStr(strSource, strStart)

    If intEndCount = 0 Then
        intEndPos = InStr(strSource, strEnd) + Len(strEnd)
    Else
        intEndPos = InStr(strSource, strEnd) + intEndCount
    End If

    If Len(strSource)> 1 And intStartPos> 0 And intEndPos> 1 Then
        If blnReturnChunk = False Then
            strStartPiece = Left(strSource, intStartPos - 1)
            strEndPiece = Mid(strSource, intEndPos)
            RemoveString = Trim(strStartPiece & strEndPiece)
        Else
            RemoveString = Trim(Mid(strSource, intStartPos, (intEndPos - intStartPos)))
        End If
    Else
        RemoveString = ""
    End If
End Function

文字列をディスク上のファイルとして保存：

  Function SaveStringAsTextFile(strSource As String, _
                              strFileName As String) As Boolean

    ' Save the string in strSource to the file supplied
    ' in strFileName. If the operation succeeds, return True;
    ' otherwise, return False. If the file described by
    ' strFileName already exists, append strSource to any
    ' existing text in the file.

    Dim intFileNumber As Integer

    On Error GoTo SaveString_Err

    ' Assume that the operation will succeed.
    SaveStringAsTextFile = True

    If Len(strSource)> 0 And InStr(strFileName, ".txt")> 0 Then
        If InStr(strFileName, ":") = 0 Or InStr(strFileName, "\") = 0 Then
            ' Invalid file path submitted.
            SaveStringAsTextFile = False
        Else
            ' Save file to disk.
            intFileNumber = FreeFile
            Open strFileName For Append As intFileNumber
            Print #intFileNumber, strSource;
            Close intFileNumber
        End If
    Else
        SaveStringAsTextFile = False
    End If

SaveString_End:
    Exit Function
SaveString_Err:
    MsgBox Err.Description, vbCritical & vbOKOnly, _
         "Error Number " & Err.Number & " Occurred"
    Resume SaveString_End
End Function

ファイルパスからファイル名を取得：

  Function NameFromPath(strPath As String) As String
    ' This procedure takes a file path and returns
    ' the file name portion.

    Dim lngPos          As Long
    Dim strPart         As String
    Dim blnIncludesFile As Boolean

    ' Check that this is a file path.
    ' Find the last path separator.
    lngPos = InStrRev(strPath, "\")
    ' Determine whether string after last backslash
    ' contains a period.
    blnIncludesFile = InStrRev(strPath, ".")> lngPos
    strPart = ""

    If lngPos> 0 Then
        If blnIncludesFile Then
            strPart = Right$(strPath, Len(strPath) - lngPos)
        End If
    End If
    NameFromPath = strPart
End Function

文字列中の単語数をカウント：

  Function CountWords(strText As String) As Long
    ' This procedure counts the number of words in a string.

    Dim astrWords() As String

    astrWords = Split(strText)
    ' Count number of elements in array—this will be the
    ' number of words.
    CountWords = UBound(astrWords) - LBound(astrWords) + 1
End Function

参考資料

ここではコードライブラリアンに含まれているサンプルコードのごく一部を紹介しました。これらはあらゆる Office プロジェクトの中で再利用できるように適切に記述された便利なプロシージャの例です。このほか、コードライブラリアンでの作業に関しては次の資料を参考にできます。

Visio のコードライブラリアンは https://msdn.microsoft.com/officedev/downloads/visio.exe からダウンロードできます。
再利用可能なコードの書き方の詳細については、「再利用可能なコードを作成する」をご覧ください。
コードライブラリアンで、または独自に使用できるその他のサンプルコードについては、MSDN Code Center（https://msdn.microsoft.com/code/default.asp）をご覧ください。
また、例によって Office Developer サイト（https://www.microsoft.com/office/developer/）の情報と Office ソリューション開発技術に関する記事（https://msdn.microsoft.com/office/）を、定期的にご覧ください。

David Shank は、Office チームにおいて開発者向けのドキュメンテーションを専門とするプログラマーでありライターでもあります。彼はレドモンドの東に位置する山の上で生活していて、ノースウエストには残り少ないネイティブであるという噂です。

Share via

巨人の肩の上に立つ

コードライブラリアンとは

サンプルコードのサンプル

日付と時刻の例

コマンドバーとメニューの例

文字列の操作

参考資料

その他のリソース

Share via

巨人の肩の上に立つ

コード ライブラリアンとは

サンプル コードのサンプル

日付と時刻の例

コマンドバーとメニューの例

文字列の操作

参考資料

その他のリソース

コードライブラリアンとは

サンプルコードのサンプル