{"id":32,"date":"2016-09-27T07:27:50","date_gmt":"2016-09-26T22:27:50","guid":{"rendered":"http:\/\/okamurax.com\/?p=32"},"modified":"2020-01-16T09:04:36","modified_gmt":"2020-01-16T00:04:36","slug":"vba-%e3%83%95%e3%82%a9%e3%83%ab%e3%83%80%e6%a7%8b%e6%88%90%e3%82%92%e3%82%b7%e3%83%bc%e3%83%88%e3%81%ab%e5%b1%95%e9%96%8b%e3%83%aa%e3%83%b3%e3%82%af%e4%bb%98%e3%81%8d","status":"publish","type":"post","link":"https:\/\/appbay.org\/?p=32","title":{"rendered":"VBA \u30d5\u30a9\u30eb\u30c0\u30fb\u30d5\u30a1\u30a4\u30eb\u306e\u30ea\u30f3\u30af\u306e\u4e00\u89a7"},"content":{"rendered":"

\u696d\u52d9\u4e0a\u306e\u30d5\u30a1\u30a4\u30eb\u3092\u30d5\u30a9\u30eb\u30c0\u7ba1\u7406\u3057\u3066\u3044\u308b\u4e2d\u5c0f\u4f01\u696d\u306f\u591a\u3044\u3068\u601d\u3044\u307e\u3059\u3002\u696d\u52d9\u5225\u306b\u30d5\u30a9\u30eb\u30c0\u3092\u4f5c\u3063\u3066\u3044\u305f\u308a\u3001\u500b\u4eba\u5225\u306b\u30d5\u30a9\u30eb\u30c0\u3092\u4f5c\u3063\u3066\u3044\u305f\u308a\u3002<\/p>\n

\u30d5\u30a9\u30eb\u30c0\u3084\u30d5\u30a1\u30a4\u30eb\u306b\u30a8\u30af\u30bb\u30eb\u304b\u3089\u30a2\u30af\u30bb\u30b9\u3067\u304d\u308b\u3068\u4fbf\u5229\u304b\u3068\u601d\u3044\u4f5c\u6210\u3057\u3066\u307f\u305f\u3002<\/p>\n

Sub auto_open()\r\n \r\n'\u53c2\u7167\u8a2d\u5b9a\u3000Microsoft Scripting Runtime\r\n\r\nOn Error Resume Next\r\n \r\nApplication.CommandBars(\"cell\").Controls(\"\u4f5c\u6210\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u4f5c\u6210\").Delete\r\n \r\nWith Application.CommandBars(\"cell\").Controls.Add\r\n  .Caption = \"\u4f5c\u6210\"\r\n  .OnAction = \"main\"\r\nEnd With\r\n \r\nEnd Sub\r\n\r\nSub auto_close()\r\n \r\nOn Error Resume Next\r\n \r\nApplication.CommandBars(\"cell\").Controls(\"\u4f5c\u6210\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u4f5c\u6210\").Delete\r\n \r\nEnd Sub\r\n\r\nSub main()\r\n    \r\nActiveSheet.Cells.ClearContents\r\nActiveSheet.Cells.ColumnWidth = 5\r\n\r\nDim obj As FileSystemObject\r\nSet obj = New FileSystemObject\r\n\r\nCall func(obj.GetFolder(ActiveWorkbook.Path), 0, 0)\r\n\r\nSet obj = Nothing\r\n \r\nEnd Sub\r\n \r\nSub func(ByVal f As Folder, ByRef r As Long, ByVal c As Long)\r\n \r\nr = r + 1\r\nc = c + 1\r\n\r\nActiveSheet.Cells(r, c).Value = f.Name\r\nActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=f.Path\r\n\r\nDim k As Folder\r\n\r\nFor Each k In f.SubFolders\r\n  Call func(k, r, c)\r\nNext k\r\n\r\nc = c + 1\r\n\r\nDim i As File\r\n\r\nFor Each i In f.Files\r\n    \r\n  If 0 = InStr(i.Name, ActiveWorkbook.Name) Then\r\n  \r\n    r = r + 1\r\n    \r\n    ActiveSheet.Cells(r, c).Value = i.Name\r\n    ActiveSheet.Hyperlinks.Add anchor:=Cells(r, c), Address:=i.Path\r\n\r\n  End If\r\n\r\nNext i\r\n\r\nSet f = Nothing\r\n    \r\nEnd Sub\r\n<\/pre>\n