{"id":2346,"date":"2012-10-22T13:22:51","date_gmt":"2012-10-22T04:22:51","guid":{"rendered":"http:\/\/www.ka-net.org\/blog\/?p=2346"},"modified":"2013-08-19T14:12:43","modified_gmt":"2013-08-19T05:12:43","slug":"%e3%83%89%e3%83%a9%e3%83%83%e3%82%b0%e3%83%89%e3%83%ad%e3%83%83%e3%83%97%e3%81%a7excel%e3%81%ae%e3%82%a2%e3%83%89%e3%82%a4%e3%83%b3%e3%82%92%e7%99%bb%e9%8c%b2%e3%81%99%e3%82%8bvbscript","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=2346","title":{"rendered":"\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3067Excel\u306e\u30a2\u30c9\u30a4\u30f3\u3092\u767b\u9332\u3059\u308bVBScript"},"content":{"rendered":"

\u300c\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3067Word\u306e\u30c6\u30f3\u30d7\u30ec\u30fc\u30c8\u3092\u767b\u9332\u30fb\u89e3\u9664\u3059\u308b(VBS)<\/a>\u300d\u3067Word\u30c6\u30f3\u30d7\u30ec\u30fc\u30c8\u306e\u767b\u9332\u30fb\u89e3\u9664\u3092\u88dc\u4f50\u3059\u308b\u30b9\u30af\u30ea\u30d7\u30c8\u3092\u7d39\u4ecb\u3057\u307e\u3057\u305f\u304c\u3001\u4eca\u56de\u306f\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3067Excel\u306e\u30a2\u30c9\u30a4\u30f3\u3092\u767b\u9332\u3059\u308b\u30b9\u30af\u30ea\u30d7\u30c8\u3092\u7d39\u4ecb\u3057\u307e\u3059\u3002<\/p>\n

\u4e0b\u8a18\u30b3\u30fc\u30c9\u306f\u3001<\/p>\n

    \n
  1. Excel\u306e\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u306e\u30d1\u30b9\u3092\u53d6\u5f97<\/li>\n
  2. \u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3055\u308c\u305f\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u3092Excel\u306e\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u306b\u30b3\u30d4\u30fc<\/li>\n
  3. \u30b3\u30d4\u30fc\u3057\u305f\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u3092\u767b\u9332<\/li>\n<\/ol>\n

    \u3068\u3044\u3063\u305f\u4f5c\u696d\u3092\u81ea\u52d5\u7684\u306b\u884c\u3044\u307e\u3059\u3002
    \n\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u306e\u30b3\u30d4\u30fc\u5148\u3092\u5909\u66f4\u3057\u305f\u3044\u3001\u8907\u6570\u306e\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u3092\u540c\u6642\u306b\u767b\u9332\u3057\u305f\u3044\u3001\u3068\u3044\u3063\u305f\u5834\u5408\u306b\u306f\u3001\u9069\u5f53\u306b\u30b3\u30fc\u30c9\u3092\u5909\u66f4\u3057\u3066\u3054\u4f7f\u7528\u304f\u3060\u3055\u3044\u3002<\/p>\n

    Option Explicit\r\n\r\nInstallAddIn()\r\nIf MsgBox("\u51e6\u7406\u304c\u7d42\u4e86\u3057\u307e\u3057\u305f\u3002" & vbCrLf & "Excel\u3092\u4eca\u3059\u3050\u8d77\u52d5\u3057\u307e\u3059\u304b\uff1f", vbYesNo) = vbYes Then _\r\nCreateObject("WScript.Shell").Run "EXCEL.EXE", 1, False\r\n\r\nPublic Sub InstallAddIn()\r\n  Dim Args\r\n  Dim SourceFilePath\r\n  Dim AddInFileName\r\n  Dim AddInFilePath\r\n  Dim AddInFolderPath\r\n  Dim Wb\r\n  Const MsgTitle = "Excel\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u767b\u9332\u30b9\u30af\u30ea\u30d7\u30c8"\r\n  \r\n  Set Args = WScript.Arguments\r\n  If Args.Count < 1 Then\r\n    MsgBox "Excel\u306b\u767b\u9332\u3057\u305f\u3044\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u3092" & vbCrLf & _\r\n           "\u5f53\u30b9\u30af\u30ea\u30d7\u30c8\u30d5\u30a1\u30a4\u30eb\u306b\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3057\u3066" & vbCrLf & _\r\n           "\u51e6\u7406\u3092\u5b9f\u884c\u3057\u3066\u304f\u3060\u3055\u3044\u3002", 16, MsgTitle\r\n    Exit Sub\r\n  ElseIf Args.Count > 1 Then\r\n    MsgBox "\u5f53\u30b9\u30af\u30ea\u30d7\u30c8\u304c\u4e00\u5ea6\u306b\u51e6\u7406\u3067\u304d\u308b\u306e\u306f1\u30d5\u30a1\u30a4\u30eb\u3060\u3051\u3067\u3059\u3002" & vbCrLf & _\r\n           "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", 16, MsgTitle\r\n    Exit Sub\r\n  End If\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    Select Case LCase(.GetExtensionName(Args(0)))\r\n      Case "xla", "xlam"\r\n        AddInFileName = .GetFileName(Args(0))\r\n        SourceFilePath = Args(0)\r\n      Case Else\r\n        MsgBox "Excel\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u3067\u306f\u3042\u308a\u307e\u305b\u3093\u3002" & vbCrLf & "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", 16, MsgTitle\r\n        Exit Sub\r\n    End Select\r\n  End With\r\n  Set Args = Nothing\r\n  \r\n  '\u30a2\u30d7\u30ea\u30b1\u30fc\u30b7\u30e7\u30f3\u8d77\u52d5\u30c1\u30a7\u30c3\u30af\r\n  If ChkApp Then\r\n    MsgBox "Excel\u304c\u8d77\u52d5\u3057\u3066\u3044\u307e\u3059\u3002" & vbCrLf & "Excel\u3092\u7d42\u4e86\u3057\u3066\u304b\u3089\u518d\u5ea6\u5b9f\u884c\u3057\u3066\u304f\u3060\u3055\u3044\u3002", 16, MsgTitle\r\n    Exit Sub\r\n  End If\r\n  \r\n  '\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u306e\u30d1\u30b9\u53d6\u5f97\r\n  AddInFolderPath = GetUserLibraryPath()\r\n  If Len(AddInFolderPath) < 1 Then\r\n    MsgBox "\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u306e\u30d1\u30b9\u306e\u53d6\u5f97\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002", 16, MsgTitle\r\n    Exit Sub\r\n  End If\r\n  If Right(AddInFolderPath, 1) <> "\\" Then AddInFolderPath = AddInFolderPath & "\\"\r\n  AddInFilePath =  AddInFolderPath & AddInFileName\r\n  \r\n  '\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb\u306e\u30b3\u30d4\u30fc\r\n  On Error Resume Next\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    If .FolderExists(AddInFolderPath) <> True Then\r\n      MsgBox "\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u304c\u898b\u3064\u304b\u308a\u307e\u305b\u3093\u3067\u3057\u305f\u3002", 16, MsgTitle\r\n      Exit Sub\r\n    End If\r\n    If .FileExists(AddInFilePath) Then\r\n      MsgBox "\u3059\u3067\u306b[" & AddInFilePath & "]\u304c\u5b58\u5728\u3057\u3066\u3044\u307e\u3059\u3002" & vbCrLf & _\r\n             "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", 16, MsgTitle\r\n      Exit Sub\r\n    End If\r\n    .CopyFile SourceFilePath, AddInFolderPath, True '\u30d5\u30a1\u30a4\u30eb\u30b3\u30d4\u30fc(\u4e0a\u66f8\u304d)\r\n  End With\r\n  \r\n  '\u30a2\u30c9\u30a4\u30f3\u306e\u767b\u9332\r\n  With CreateObject("Excel.Application")\r\n    .Visible = True\r\n    Set Wb = .Workbooks.Add()\r\n    .AddIns.Add(AddInFilePath).Installed = True\r\n    Wb.Close False\r\n    .Quit\r\n  End With\r\n  If Err.Number <> 0 Then\r\n    MsgBox "\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u307e\u3057\u305f\u3002" & vbCrLf & "\u30a8\u30e9\u30fc\u5185\u5bb9 : " & Err.Description, 16, MsgTitle\r\n    Err.Clear\r\n    Exit Sub\r\n  End If\r\n  On Error GoTo 0\r\nEnd Sub\r\n\r\n'\u30a2\u30c9\u30a4\u30f3\u30d5\u30a9\u30eb\u30c0\u306e\u30d1\u30b9\u53d6\u5f97\r\nPrivate Function GetUserLibraryPath()\r\n  Dim ret\r\n  \r\n  ret = "" '\u521d\u671f\u5316\r\n  On Error Resume Next\r\n  With CreateObject("Excel.Application")\r\n    .Visible = False\r\n    ret = .UserLibraryPath\r\n    .Quit\r\n  End With\r\n  Err.Clear\r\n  On Error GoTo 0\r\n  GetUserLibraryPath = ret\r\nEnd Function\r\n\r\n'Excel\u306e\u8d77\u52d5\u30c1\u30a7\u30c3\u30af\r\nPrivate Function ChkApp()\r\n  Dim app, ret\r\n  \r\n  ret = False '\u521d\u671f\u5316\r\n  On Error Resume Next\r\n  Set app = GetObject(, "Excel.Application")\r\n  Err.Clear\r\n  On Error GoTo 0\r\n  If Not IsEmpty(app) Then ret = True\r\n  ChkApp = ret\r\nEnd Function<\/pre>\n
    \u25a0 \u4f7f\u3044\u65b9<\/h4>\n
      \n
    1. \u4e0a\u8a18\u30b3\u30fc\u30c9\u3092\u30b3\u30d4\u30fc\u3057\u3066\u30e1\u30e2\u5e33\u306b\u8cbc\u308a\u4ed8\u3051\u307e\u3059\u3002<\/li>\n
    2. \u62e1\u5f35\u5b50\u3092\u300cvbs<\/span>\u300d\u306b\u3057\u3066\u4fdd\u5b58\u3057\u307e\u3059\u3002<\/li>\n
    3. Excel\u3092\u7d42\u4e86\u3057\u305f\u72b6\u614b\u3067\u3001\u624b\u98062.\u3067\u4fdd\u5b58\u3057\u305fvbs\u30d5\u30a1\u30a4\u30eb\u306bExcel\u306e\u30a2\u30c9\u30a4\u30f3\u30d5\u30a1\u30a4\u30eb(xla,xlam<\/span>)\u3092\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3057\u307e\u3059\u3002<\/li>\n<\/ol>\n","protected":false},"excerpt":{"rendered":"\u300c\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3067Word\u306e\u30c6\u30f3\u30d7\u30ec\u30fc\u30c8\u3092\u767b\u9332\u30fb\u89e3\u9664\u3059\u308b(VBS)\u300d\u3067Word\u30c6\u30f3\u30d7\u30ec\u30fc\u30c8\u306e\u767b\u9332\u30fb\u89e3\u9664\u3092\u88dc\u4f50\u3059\u308b\u30b9\u30af\u30ea\u30d7\u30c8\u3092\u7d39\u4ecb\u3057\u307e\u3057\u305f\u304c\u3001\u4eca\u56de\u306f\u30c9\u30e9\u30c3\u30b0&\u30c9\u30ed\u30c3\u30d7\u3067Excel\u306e\u30a2\u30c9\u30a4\u30f3\u3092\u767b\u9332\u3059\u308b […]","protected":false},"author":1,"featured_media":7111,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[48,4,6],"tags":[139,46],"class_list":["post-2346","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-excel-office","category-office","category-vbs","tag-vbs","tag-excel"],"aioseo_notices":[],"aioseo_head":"\n\t\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t