{"id":1043,"date":"2017-03-06T19:50:35","date_gmt":"2017-03-06T10:50:35","guid":{"rendered":"http:\/\/okamurax.com\/?p=1043"},"modified":"2017-03-06T19:50:35","modified_gmt":"2017-03-06T10:50:35","slug":"vba-%e8%be%b2%e7%94%a3%e7%89%a9%e5%a3%b2%e4%b8%8a%e9%9b%86%e8%a8%88","status":"publish","type":"post","link":"https:\/\/appbay.org\/?p=1043","title":{"rendered":"VBA \u8fb2\u7523\u7269\u58f2\u4e0a\u96c6\u8a08"},"content":{"rendered":"

mdb\u306b\u767b\u9332\u3059\u308b\u4e88\u5b9a\u3067\u4f5c\u6210\u3057\u3066\u3044\u305f\u304c\u3001\u9014\u4e2d\u3067\u30a8\u30af\u30bb\u30eb\u306e\u307f\u306b\u3057\u3088\u3046\u3068\u601d\u3044\u4e2d\u65ad\u3002<\/p>\n

Sub auto_open()\r\n\r\nOn Error Resume Next\r\n\r\nApplication.CommandBars(\"cell\").Controls(\"\u51e6\u7406\u5b9f\u884c\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u30b7\u30fc\u30c8\u521d\u671f\u5316(\u8cbc\u4ed8\u524d\u51e6\u7406)\").Delete\r\n\r\nWith Application.CommandBars(\"cell\").Controls.Add\r\n.FaceId = 18\r\n.Caption = \"\u30b7\u30fc\u30c8\u521d\u671f\u5316(\u8cbc\u4ed8\u524d\u51e6\u7406)\"\r\n.OnAction = \"SheetsClear\"\r\nEnd With\r\n\r\nWith Application.CommandBars(\"cell\").Controls.Add\r\n.FaceId = 18\r\n.Caption = \"\u51e6\u7406\u5b9f\u884c\"\r\n.OnAction = \"MainProcedure\"\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(\"\u51e6\u7406\u5b9f\u884c\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u30b7\u30fc\u30c8\u521d\u671f\u5316(\u8cbc\u4ed8\u524d\u51e6\u7406)\").Delete\r\n\r\nEnd Sub\r\n\r\nSub SheetsClear()\r\n\r\nSheets(\"<\u5b9f\u7e3e\u8868\u96c6\u8a08\u8868>\u8cbc\u4ed81\").Rows(\"1:1000\").Delete\r\nSheets(\"<\u5b9f\u7e3e\u8868\u96c6\u8a08\u8868>\u8cbc\u4ed82\").Rows(\"1:1000\").Delete\r\nSheets(\"<\u8cb7\u53d6\u696d\u8005\u5225 \u624b\u6570\u6599\u96c6\u8a08\u4e00\u89a7\u8868>\u8cbc\u4ed8\").Rows(\"1:1000\").Delete\r\n\r\nEnd Sub\r\n\r\nSub MainProcedure()\r\n\r\nOn Error GoTo e\r\n\r\nYearMonth = InputBox(\"\u767b\u9332\u6708\u3092YYYY\/MM\u306e\u5f62\u5f0f\u3067\u5165\u529b\u3057\u3066\u304f\u3060\u3055\u3044\u3002\")\r\nYearMonth = StrConv(YearMonth, vbNarrow)\r\nYearMonth = YearMonth & \"\/01\"\r\n\r\nIf True = IsDate(YearMonth) Then\r\n\r\n  yesno = MsgBox(Format(YearMonth, \"yyyy\u5e74mm\u6708\") & \"\u3067\u3088\u308d\u3057\u3044\u3067\u3059\u304b\uff1f\", vbYesNo)\r\n  If yesno = vbNo Then Exit Sub\r\n\r\nElse\r\n\r\n  MsgBox \"\u6b63\u3057\u3044\u767b\u9332\u6708\u3092\u5165\u529b\u3057\u3066\u304f\u3060\u3055\u3044\u3002\"\r\n  Exit Sub\r\n\r\nEnd If\r\n\r\nIf False = DataUpload(\"<\u5b9f\u7e3e\u8868\u96c6\u8a08\u8868>\u8cbc\u4ed81\", 1, YearMonth) Then GoTo e\r\nIf False = DataUpload(\"<\u5b9f\u7e3e\u8868\u96c6\u8a08\u8868>\u8cbc\u4ed82\", 1, YearMonth) Then GoTo e\r\nIf False = DataUpload(\"<\u8cb7\u53d6\u696d\u8005\u5225 \u624b\u6570\u6599\u96c6\u8a08\u4e00\u89a7\u8868>\u8cbc\u4ed8\", 2, YearMonth) Then GoTo e\r\n\r\nMsgBox \"\u5b8c\u4e86\u3057\u307e\u3057\u305f\u3002\"\r\n\r\nExit Sub\r\n\r\ne:\r\n  \r\n  MsgBox \"\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u3066\u3044\u307e\u3059\u3002\"\r\n\r\nEnd Sub\r\n\r\nFunction DataUpload(sheetName, sheetType, salesDate)\r\n\r\nOn Error GoTo e\r\n\r\nSet con = CreateObject(\"adodb.connection\")\r\ncon.Open (\"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\" & ThisWorkbook.Path & \"\/sales.mdb\")\r\n\r\nDim w As Worksheet: Set w = Sheets(sheetName)\r\n\r\n\r\nFor r = 1 To w.UsedRange.Rows.Count\r\n\r\n  If sheetType = 1 And _\r\n  w.Cells(r, 1).Text <> \"\" And IsNumeric(w.Cells(r, 1).Text) And _\r\n  w.Cells(r, 8).Text <> \"\" And IsNumeric(w.Cells(r, 8).Text) Then\r\n  \r\n    partnerCode = w.Cells(r, 1).Text\r\n    partnerName = w.Cells(r, 2).Text\r\n    salesVolume = w.Cells(r, 6).Text\r\n    salesAmount = w.Cells(r, 7).Text\r\n    marginCost = w.Cells(r, 10).Text\r\n    pointCost = w.Cells(r, 18).Text\r\n    overheadCost = w.Cells(r, 19).Text\r\n    \r\n    q = \"insert into SalesTable (\u58f2\u4e0a\u5e74\u6708\u65e5,\u30d1\u30fc\u30c8\u30ca\u30fcID,\u30d1\u30fc\u30c8\u30ca\u30fc\u540d\u79f0,\u58f2\u4e0a\u6570\u91cf,\u58f2\u4e0a\u91d1\u984d,\u624b\u6570\u6599,\u30dd\u30a4\u30f3\u30c8\u8ca0\u62c5\u984d,\u8af8\u7d4c\u8cbb,\u767b\u9332\u65e5\u6642) \" & _\r\n    \"values (#\" & salesDate & \"#,'\" & partnerCode & \"','\" & partnerName & \"','\" & salesVolume & \"','\" & salesAmount & \"','\" & marginCost & \"','\" & pointCost & \"','\" & overheadCost & \"',#\" & Now() & \"#)\"\r\n    \r\n    con.Execute q\r\n  \r\n  End If\r\n  \r\n  If sheetType = 2 And _\r\n  w.Cells(r, 1).Text <> \"\" And IsNumeric(w.Cells(r, 1).Text) And _\r\n  w.Cells(r, 4).Text <> \"\" And IsNumeric(w.Cells(r, 4).Text) Then\r\n  \r\n    partnerCode = w.Cells(r, 1).Text\r\n    partnerName = w.Cells(r, 2).Text\r\n    salesVolume = w.Cells(r, 4).Text\r\n    salesAmount = w.Cells(r, 5).Text\r\n    marginCost = w.Cells(r, 7).Text\r\n    pointCost = w.Cells(r, 9).Text\r\n    overheadCost = 0\r\n\r\n    q = \"insert into SalesTable (\u58f2\u4e0a\u5e74\u6708\u65e5,\u30d1\u30fc\u30c8\u30ca\u30fcID,\u30d1\u30fc\u30c8\u30ca\u30fc\u540d\u79f0,\u58f2\u4e0a\u6570\u91cf,\u58f2\u4e0a\u91d1\u984d,\u624b\u6570\u6599,\u30dd\u30a4\u30f3\u30c8\u8ca0\u62c5\u984d,\u8af8\u7d4c\u8cbb,\u767b\u9332\u65e5\u6642) \" & _\r\n    \"values (#\" & salesDate & \"#,'\" & partnerCode & \"','\" & partnerName & \"','\" & salesVolume & \"','\" & salesAmount & \"','\" & marginCost & \"','\" & pointCost & \"','\" & overheadCost & \"',#\" & Now() & \"#)\"\r\n    \r\n    con.Execute q\r\n    \r\n  End If\r\n\r\nNext r\r\n\r\nIf con.State = 1 Then con.Close\r\nSet con = Nothing\r\n\r\nDataUpload = True\r\n\r\nExit Function\r\n\r\ne:\r\n\r\n  If con.State = 1 Then con.Close\r\n  Set con = Nothing\r\n  \r\n  DataUpload = False\r\n  \r\nEnd Function\r\n\r\nSub MasterUpdate()\r\n\r\nOn Error GoTo e\r\n\r\nSet con = CreateObject(\"adodb.connection\")\r\ncon.Open (\"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\" & ThisWorkbook.Path & \"\/sales.mdb\")\r\n\r\nq = \"delete from MasterTable\"\r\ncon.Execute q\r\n\r\nDim w As Worksheet: Set w = Sheets(\"\u30de\u30b9\u30bf\")\r\n        \r\nFor r = 1 To w.UsedRange.Rows.Count\r\n\r\n  If w.Cells(r, 1).Text <> \"\" And w.Cells(r, 2).Text <> \"\" And w.Cells(r, 3).Text <> \"\" Then\r\n  \r\n    Select Case w.Cells(r, 3).Text\r\n    \r\n      Case \"\u6b63\u5951\u7d04\u8fb2\u7523\u7269\", \"\u6e96\u5951\u7d04\u8fb2\u7523\u7269\", \"\u59d4\u8a17\u8fb2\u7523\u7269\", \"\u8cb7\u53d6\u8fb2\u7523\u7269\", \"\u82b1\u5349\", \"\u5951\u7d04\u52a0\u5de5\u54c1\", \"\u59d4\u8a17\u52a0\u5de5\u54c1\", \"\u8cb7\u53d6\u52a0\u5de5\u54c1\"\r\n      \r\n        partnerCode = w.Cells(r, 1).Text\r\n        partnerName = w.Cells(r, 2).Text\r\n        partnerType = w.Cells(r, 3).Text\r\n    \r\n        q = \"insert into MasterTable (\u30d1\u30fc\u30c8\u30ca\u30fcID,\u30d1\u30fc\u30c8\u30ca\u30fc\u540d\u79f0,\u30d1\u30fc\u30c8\u30ca\u30fc\u30bf\u30a4\u30d7,\u767b\u9332\u65e5\u6642) \" & _\r\n        \"values ('\" & partnerCode & \"','\" & partnerName & \"','\" & partnerType & \"',#\" & Now() & \"#)\"\r\n        \r\n        con.Execute q\r\n        \r\n        w.Rows(r).Columns(\"A:C\").Interior.ColorIndex = 0 ' OK\u306e\u5834\u5408\r\n    \r\n      Case Else\r\n      \r\n        w.Cells(r, 3).Interior.Color = RGB(255, 0, 0) 'A:C\u306f\u7a7a\u767d\u3067\u306f\u306a\u3044\u304c\u3001C\u5217\u304c\u4e0d\u6b63\r\n\r\n    End Select\r\n    \r\n  Else\r\n  \r\n    w.Rows(r).Columns(\"A:C\").Interior.Color = RGB(255, 0, 0) 'A:C\u5217\u306e\u4f55\u308c\u304b\u7a7a\u767d\r\n  \r\n  End If\r\n\r\nNext r\r\n\r\nIf con.State = 1 Then con.Close\r\nSet con = Nothing\r\n\r\nMsgBox \"\u5b8c\u4e86\u3057\u307e\u3057\u305f\u3002\"\r\n\r\nExit Sub\r\n\r\ne:\r\n\r\n  If con.State = 1 Then con.Close\r\n  Set con = Nothing\r\n  \r\n  MsgBox \"\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u3066\u3044\u307e\u3059\u3002\"\r\n  \r\nEnd Sub\r\n\r\nSub DataDelte()\r\n\r\nOn Error GoTo e\r\n\r\nDim w As Worksheet: Set w = Sheets(\"\u8868\u7d19\")\r\n\r\nyesno = MsgBox(w.Cells(6, 2).Text & \"\u306e\u65e5\u4ed8\u3067\u767b\u9332\u3057\u305f\u30c7\u30fc\u30bf\u306f\u5168\u3066\u524a\u9664\u3055\u308c\u307e\u3059\u3002\u3088\u308d\u3057\u3044\u3067\u3059\u304b\uff1f\", vbYesNo)\r\nIf yesno = vbNo Then Exit Sub\r\n\r\nSet con = CreateObject(\"adodb.connection\")\r\ncon.Open (\"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\" & ThisWorkbook.Path & \"\/sales.mdb\")\r\n\r\nq = \"delete from SalesTable where \u58f2\u4e0a\u5e74\u6708\u65e5 = #\" & w.Cells(6, 2).Text & \"#\"\r\ncon.Execute q\r\n\r\nIf con.State = 1 Then con.Close\r\nSet con = Nothing\r\n\r\nMsgBox \"\u5b8c\u4e86\u3057\u307e\u3057\u305f\u3002\"\r\n\r\nExit Sub\r\n\r\ne:\r\n\r\n  If con.State = 1 Then con.Close\r\n  Set con = Nothing\r\n  \r\n  MsgBox \"\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u3066\u3044\u307e\u3059\u3002\"\r\n  \r\nEnd Sub\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"
mdb\u306b\u767b\u9332\u3059\u308b\u4e88\u5b9a\u3067\u4f5c\u6210\u3057\u3066\u3044\u305f\u304c\u3001\u9014\u4e2d\u3067\u30a8\u30af\u30bb\u30eb\u306e\u307f\u306b\u3057\u3088\u3046\u3068\u601d\u3044\u4e2d\u65ad\u3002 Sub auto_open() On Error Resume Next Application.CommandBars(“cell”).Co … <\/p>\n
“VBA \u8fb2\u7523\u7269\u58f2\u4e0a\u96c6\u8a08” \u306e<\/span>\u7d9a\u304d\u3092\u8aad\u3080<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[1],"tags":[5],"class_list":["post-1043","post","type-post","status-publish","format-standard","hentry","category-1","tag-vba"],"_links":{"self":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1043","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1043"}],"version-history":[{"count":1,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1043\/revisions"}],"predecessor-version":[{"id":1044,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1043\/revisions\/1044"}],"wp:attachment":[{"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1043"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=1043"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=1043"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}