Excel

ドラッグ&ドロップでExcelのアドインを登録するVBScript

ドラッグ&ドロップでWordのテンプレートを登録・解除する(VBS)」でWordテンプレートの登録・解除を補佐するスクリプトを紹介しましたが、今回はドラッグ&ドロップでExcelのアドインを登録するスクリプトを紹介します。

下記コードは、

  1. Excelのアドインフォルダのパスを取得
  2. ドラッグ&ドロップされたアドインファイルをExcelのアドインフォルダにコピー
  3. コピーしたアドインファイルを登録

といった作業を自動的に行います。
アドインファイルのコピー先を変更したい、複数のアドインファイルを同時に登録したい、といった場合には、適当にコードを変更してご使用ください。

Option Explicit

InstallAddIn()
If MsgBox("処理が終了しました。" & vbCrLf & "Excelを今すぐ起動しますか?", vbYesNo) = vbYes Then _
CreateObject("WScript.Shell").Run "EXCEL.EXE", 1, False

Public Sub InstallAddIn()
  Dim Args
  Dim SourceFilePath
  Dim AddInFileName
  Dim AddInFilePath
  Dim AddInFolderPath
  Dim Wb
  Const MsgTitle = "Excelアドインファイル登録スクリプト"
  
  Set Args = WScript.Arguments
  If Args.Count < 1 Then
    MsgBox "Excelに登録したいアドインファイルを" & vbCrLf & _
           "当スクリプトファイルにドラッグ&ドロップして" & vbCrLf & _
           "処理を実行してください。", 16, MsgTitle
    Exit Sub
  ElseIf Args.Count > 1 Then
    MsgBox "当スクリプトが一度に処理できるのは1ファイルだけです。" & vbCrLf & _
           "処理を中止します。", 16, MsgTitle
    Exit Sub
  End If
  With CreateObject("Scripting.FileSystemObject")
    Select Case LCase(.GetExtensionName(Args(0)))
      Case "xla", "xlam"
        AddInFileName = .GetFileName(Args(0))
        SourceFilePath = Args(0)
      Case Else
        MsgBox "Excelアドインファイルではありません。" & vbCrLf & "処理を中止します。", 16, MsgTitle
        Exit Sub
    End Select
  End With
  Set Args = Nothing
  
  'アプリケーション起動チェック
  If ChkApp Then
    MsgBox "Excelが起動しています。" & vbCrLf & "Excelを終了してから再度実行してください。", 16, MsgTitle
    Exit Sub
  End If
  
  'アドインフォルダのパス取得
  AddInFolderPath = GetUserLibraryPath()
  If Len(AddInFolderPath) < 1 Then
    MsgBox "アドインフォルダのパスの取得に失敗しました。", 16, MsgTitle
    Exit Sub
  End If
  If Right(AddInFolderPath, 1) <> "\" Then AddInFolderPath = AddInFolderPath & "\"
  AddInFilePath =  AddInFolderPath & AddInFileName
  
  'アドインファイルのコピー
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    If .FolderExists(AddInFolderPath) <> True Then
      MsgBox "アドインフォルダが見つかりませんでした。", 16, MsgTitle
      Exit Sub
    End If
    If .FileExists(AddInFilePath) Then
      MsgBox "すでに[" & AddInFilePath & "]が存在しています。" & vbCrLf & _
             "処理を中止します。", 16, MsgTitle
      Exit Sub
    End If
    .CopyFile SourceFilePath, AddInFolderPath, True 'ファイルコピー(上書き)
  End With
  
  'アドインの登録
  With CreateObject("Excel.Application")
    .Visible = True
    Set Wb = .Workbooks.Add()
    .AddIns.Add(AddInFilePath).Installed = True
    Wb.Close False
    .Quit
  End With
  If Err.Number <> 0 Then
    MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容 : " & Err.Description, 16, MsgTitle
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
End Sub

'アドインフォルダのパス取得
Private Function GetUserLibraryPath()
  Dim ret
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("Excel.Application")
    .Visible = False
    ret = .UserLibraryPath
    .Quit
  End With
  Err.Clear
  On Error GoTo 0
  GetUserLibraryPath = ret
End Function

'Excelの起動チェック
Private Function ChkApp()
  Dim app, ret
  
  ret = False '初期化
  On Error Resume Next
  Set app = GetObject(, "Excel.Application")
  Err.Clear
  On Error GoTo 0
  If Not IsEmpty(app) Then ret = True
  ChkApp = ret
End Function

■ 使い方

  1. 上記コードをコピーしてメモ帳に貼り付けます。
  2. 拡張子を「vbs」にして保存します。
  3. Excelを終了した状態で、手順2.で保存したvbsファイルにExcelのアドインファイル(xla,xlam)をドラッグ&ドロップします。

関連記事

  1. Excel

    Google翻訳で文字列を翻訳するマクロ

    ※ 2016/2 時点では下記の方法はもう使用できなくなっています。V…

  2. Office アドイン

    [Office用アプリ]User Agent他を調べてみました。

    ふと気になったので、Office 用アプリをローカル環境にインストール…

  3. Office関連

    ルビ(ふりがな)を一括設定するWordマクロ(改良版)

    これまで当ブログではルビを設定するWordマクロについて、いくつか記事…

  4. Office関連

    各ページを画像に変換するWordマクロ

    Excel MVPの伊藤さんがブログで、WordのPageオブジェクト…

  5. Office関連

    Office 2013関連資料のリンク

    Office 2013関連資料のリンクをメモしておきます。・O…

  6. Office関連

    オデッセイ コミュニケーションズ主催のWord活用無料セミナーに参加しました。

    Club Microsoft会員限定、オデッセイ コミュニケーションズ…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP