<92C789C182502E786C73>

Transcription

1 様 式 Z156 承 認 確 認 作 改 版 定 理 由 定 符 号 改 定 発 所 成 日 行 属 者 改 定 年 内 容 月 承 日 (..) 認 確 認 担 当 エクセルにカスタムコマンドを 第 エクセルは ものです コマンドをVBAで エクセルの 一 段 階 非 常 にたくさんのコマンドが 作 り 登 録 有 する りますが ここで 方 法 について するコマンドはエクセルの する 標 準 には 無 い 標 準 バーにメニューバーを 作 りメニュー 表 登 示 録 させるコマンド する 手 順 を 説 明 追 します 加 1 を 登 録 する 第 コマンド 2 段 階 追 加 1 をクリックした 時 表 示 させるメニューバー 小 道 具 を 登 録 する エクセルにマクロを 登 録 メニューバーを 追 加 第 3 メニューバーをクリックした 後 処 マクロの 段 理 半 階 角 変 換 登 録 大 文 字 変 換 時 実 行 小 されるマクロ セル 文 字 変 換 を 登 録 する 値 保 存 セル 値 シート 名 全 角 変 換 追 加 したメニューの アドインへの なります 登 録 消 去 登 録 の 仕 方 を 説 明 します アドインへ 登 録 するといつでも 登 録 したコマンドが 利 用 出 来 る 様 に シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 1/

2 様 式 第 Z157 版 エクセルの 一 段 階 発 行 年 月 日 ここではコマンド 標 準 名 バーにメニューバーを を 1 としたが もちろんこの 表 示 させるコマンド 名 前 は 好 追 みで 加 1 の 変 えてもかまわない 登 録 又 では メニューバーに ALT+F11(ALTキーを 表 示 -ツールバー-Vsual 追 押 加 しながらF11を 1 を 表 Basic 示 するプログラムについて 押 でvbaメニューバーを す)とVBAの 記 述 画 説 表 面 明 示 になります する し Viual Basic Eeditor より 開 きます ここで モジュール1をクリックし この この 画 面 挿 入 - 標 準 メニューをクリックするとプロジェクトにModule1が 中 にプログラムを 書 きます 追 加 されます モジュール1に 記 述 するプログラム シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁

3 様 式 Z157 Sub Auto_Open() 版 発 行 年 月 日 Dim ' 立 ち mycb myctrl 上 げ 時 As 自 Application.CommandBars("Worksheet 動 CommandBarControl 実 行 処 理 mycb.controls(" Set On myctrl Error Resume mycb.controls.add 追 加 Next 1").Delete Menu Bar") With.Style.Caption.OnAction myctrl = msobuttoncaption End myctrl With = = " 追 "メニュー 加 1" Set mycb = Nothing 追 加 " End Sub プログラムの Sub 説 明 openした 時 自 動 実 行 するマクロとして 宣 言 Dim ' 立 Auto_Open() ち mycb myctrl 上 げ 時 As 自 動 CommandBarControl 実 行 処 理 コメント 変 数 宣 mycb 言 文 dim コメントは と a myctrl as 行 b 頭 に を 変 エクセル 数 を aはbで 追 加 変 する 数 有 に る宣 言 Set mycb = Application.CommandBars("Worksheet CommandBar エクセルの 変 数 CommandBarControl タイプ は mycb を 標 Menu 準 メニューバーの Bar") エラーが 1が 無 発 いとエラーとなるが 生 した 時 の 次 処 の 値 を にプログラムを 記 変 述 数 にセット On Error Resume 移 す Nextで 処 置 Set mycb.controls(" On Error Resume OnAction = "メニュー 追 加 " 28 End.Style.Caption myctrl With= msobuttoncaption = mycb.controls.add 追 加 Next 1").Delete With myctrl " 追 加 1" クリックされた スタイルを 説 標 追 myctrl 明 準 加 文 メニューバーmyCBにmyCtrl 1を 削 除 ( 複 数 回 実 行 時 の2 に 追 説 With 加 明 変 マクロの 数 の 解 終 実 1 文 行 ~ のボタン するマクロは とする End With にする 追 重 の 加 登 録 をさける) 追 間 加 を メニュー とする 宣 言 放 了 宣 言 16,23,24 以 End Set 上 が Sub myctrl mycb = Nothing 第 行 一 目 段 を 階 シチズンセイミツ 変 メニューバーに 更 すれば 自 由 株 に 新 式 使 しいメニュー 会 用 社 可 能 です 追 加 1 を 表 示 させるプログラムです 文 書 番 号 02/(Z0R501) 頁 3/

4 様 式 第 Z157 コマンド 2 段 階 版 Sub 追 メニュー 加 1 をクリックした 追 加 () 時 表 示 させるメニューバー 小 道 具 を 登 録 発 する 行 年 月 日 Dim On Set ' Application.CommandBars(" Error xlapp xlapp objbar objbar Resume As ' Caption End.Caption.Style.BeginGroup = As ' OnAction End.TooltipText = xlapp.commandbars.add(name:=" Next With objbar.controls.add(type:=msocontrolbutton) 小 道 具 ").Delete = With objbar.controls.add(type:=msocontrolbutton) With= msobuttonicon = With = True "ファイル 名 をセル 値 にして 小 保 道 存 具 "", Position:=msoBarTop) ' OnAction With objbar.controls.add(type:=msocontrolbutton).faceid = = 271"セル 値 保 存 ".FaceId 2587 "シート "セル 名 をセル シート 名 値 " で 置 換 " = " " With objbar.controls.add(type:=msocontrolbutton).onaction = " 全 角 " ' With objbar.controls.add(type:=msocontrolbutton) ' With objbar.controls.add(type:=msocontrolbutton) End 'メニュー Set Sub objbar.visible 後 処 理.OnAction End.BeginGroup.Style msobuttoncaption.caption End.Caption.Style.OnAction End.BeginGroup.Style msobuttonicon With With msobuttoncaption = True 半.OnAction With= = " = " 大 True 文 字 "".Style End.Caption.Style = =================================== = Nothing With = True msobuttoncaption msobuttoncaption 小 '' ツールハ ーを オフ シ ェクトを 表 廃 示 棄 する シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 4/

5 様 式 Z157 Sub プログラムの メニュー 追 加 説 () 明 版 発 行 年 月 日 Dim Application.CommandBars(" On Error objbar xlapp xlapp Resume As As = Next マクロ 小 道 具 ").Delete 変 エラー 名 メニュー 追 加 とする sub ()は 決 まり 文 句 Set objbar = xlapp.commandbars.add(name:=" 2 数 宣 発 言 生 objbar 時 xlapp の 処 理 を 無 アプリケーションタイプに コマンドーバータイプに 視 して 次 行 実 行 宣 言 ", Position:=msoBarTop) ' objbarを xlappをアプリケーションにセット 重 登 録 防 止 のため 有 れば 削 除 する 小 道 具 と 言 う 名 前 のコマンドバーとして With objbar.controls.add(type:=msocontrolbutton) xlappに.begingroup.tooltiptext = = True Position 追 ( 加 位 する 置.OnAction.FaceId = = 271"セル "ファイル 値 保 存 名 " をセル 値 にして 保 存 " 仕 )を マウスが objbarにコントロールボタンを 切 り top( 線 置 追 上 かれた 加 )に 設 定 時 の 説 明 チップ 追 加 End.Style With= msobuttonicon 実 行 マクロを するアイコンのid 指 定 番 号 アイコンはエクセルに 例 メニューバーに ここではアイコンとしました を 下 記 にひょうじします ( 表 示 する 標 準 形 で 状 詳 多 を.Style 表 示 タイルをアイコンにする 細 数 271を はインターネットで 有 り faceidと 指 = 定 でアイコン しています 言 います 検 又 索 は してください) 文 字 から 選 べます ' With objbar.controls.add(type:=msocontrolbutton) End.Caption.OnAction.FaceId.Style With= = = msobuttonicon = 2587 "シート "セル 名 値 をセル シート 名 値 " で 置 換 " セル 値 シート 名 も 上 記 と 同 じです Faicedを2587を 指 定 しています シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 5/

6 様 式 Z157 ' With objbar.controls.add(type:=msocontrolbutton) 版 発 行 年 月 日.Caption.OnAction.Style.BeginGroup = True End With= = msobuttoncaption = " " 全 角 "" ' ここはスタイルをCaption( With objbar.controls.add(type:=msocontrolbutton) されます 見 出 し)としましたので メニューバーには 全 角 と 表 示.Caption ' FaceId With objbar.controls.add(type:=msocontrolbutton).style End.OnAction With objbar.controls.add(type:=msocontrolbutton).style.begingroup With= = = msobuttoncaption 2587 " 半 角 " End.Caption End.Caption With= msobuttoncaption = " = 大 True 文 ' 字 ".OnAction.Style With= = msobuttoncaption = " " 小 文 字 "" End 'メニュー Set Sub objbar.visible 後 処 理 =================================== 以 上 は 同 様 の 処 理 の 繰 り 返 しです = Nothing = True '' ツールハ ーを オフ シ ェクトを 表 廃 示 棄 する 以 メニューに して 上 下 で さいメニューバーのプログラムは 表 示 するコマンドを 増 やすには 終 了 上 です 記 With から End With までを 追 加 シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 6/

7 様 式 Z157 第 3 段 階 版 いよいよ マクロ マクロの Private 名 はメニューの 最 後 登 のマクロの 録 発 行 年 月 日 Dim tmp myfile tmp myfile = Sub ActiveWorkbook.Path = As tmp セル As String & String 値.OnAction 登 録 です "\" 保 存 & () で 指 定 した 名 前 です モジュール1に 書 きます If Dim myfilename InitialFileName:=myFile, myfilename = "False" Application.GetSaveAsFilename( As String ActiveCell.Value セルの にして 保 値 存 をファイル するマクロ名 End Sub ActiveWorkbook.SaveAs Then filefilter:="excelファイル,*.xls") Filename:=myFileName Exit Sub _ Private Dim プログラムの 説 明 myfile Dim tmp tmp myfile = Sub myfilename ActiveWorkbook.Path = As セル tmp As String 値 & String 保 存 () = "\" Application.GetSaveAsFilename( As & String ActiveCell.Value tmpアクテブブックのパスを tmp を を 文 字 文 タイプ 字 タイプ 代 入 _ ウィンドウズ myfileにアクテブブックのパスとアクテブセル の 変 値 数 を 宣 代 言 入 myfilename 標 準 の 保 存 用 を 窓 文 を 字 開 タイプ く If InitialFileName:=myFile, myfilename = "False" filefilter:="excelファイル,*.xls") End Sub ActiveWorkbook.SaveAs Then Filename:=myFileName Exit Sub 保 myfilenameがヌルだとマクロを 初 シチズンセイミツ 株 式 会 社 ファイルの.xlsとしている 存 期 するファイル 名 を 名 myffile をmyFileNameに とし ファイルタイプを 中 断 代 入 文 書 保 番 存 号 02/(Z0R501) 頁 7/

8 様 式 Z157 版 発 行 年 月 日 Private Dim On sn Sub セル 値 シート 名 () 変 セルの snの エラー 数 宣 snにセルの 言 値 発 をシート タイプを 生 の 時 中 の でシート 指 名 白 に 変 換 する処 値 定 にするマクロ For しないで 理 を 代 ER:へジャンプ 名 入 snを1 ずつに 分 解 し 順 に dim 次 使 変 文 用 数 字 できない 変 数 でも を 比 較 文 宣 し 字 言 使 を できる 用 空 = Error n, s ActiveCell.Value msg, = 1 GoTo s, sn Len(sn) ER ":", "*", "\", "/", "?", ") ") きない 文 字 は 空 白 に 変 換 している で "]", ":", "[", ") 文 For を 実 は ~ s 行 = 指 します 1 Next 定 To 回 Len(sn) 数 文 処 が 理 使 を われています For sが1からsnの 繰 り 返 す 命 令 です 文 字 ~ 数 分 Next 処 理 sn Application.Substitute(sn, "/", "?", "*", " "," ") For Next sn "[", If = Application.Substitute(sn, s "]","") End n Sheets(n).Name GoTo = If 1 To Nm Sheets.Count = sn Then します For 順 次 ~ 比 較 Next し 同 じものが 文 で 同 じ 有 名 った 前 のシート 場 合 はNm:へジャンプ 名 が 無 いか Nm:MsgBox Next ActiveSheet.Name n = sn シート マクロ 名 中 変 断 更 ER: & Exit MsgBox Exit " 同 Sub Sub じシート sn & 同 じファイル 名 が 有 った 時 メッセ-ジを 表 示 する "error 名 Chr(10) シート がすでにあります" _ 名 は30 文 字 までです" エラーの 時 メッセ-ジを 表 示 する If End Sub Else 条 件 then End If 真 擬 の 場 合 の 処 理 If 文 も は 使 判 用 断 されています が 必 要 な 時 使 用 されます シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 8/

9 様 式 文 Z157 字 変 換 のプログラム4 種 Next End Dim For Private Each s.value Private Sub ss Sub s In = 全 Range(Selection.Address) StrConv(s.Value, 角 () vbwide) Dim For Next s Sub 半 角 () End Each s.value Sub s s In = Range(Selection.Address) StrConv(s.Value, vbnarrow) Private Sub 大 文 字 () Next Dim s End For Each s.value Sub s s In = Range(Selection.Address) StrConv(s.Value, vbuppercase) Private Dim Sub 小 文 字 () Next End For Each s.value Sub s s In = Range(Selection.Address) StrConv(s.Value, vblowercase) Next For Each A A In B VBAの 変 換 関 数 を 使 用 版 します 発 行 年 月 日 選 StrCon( s.valueを 択 範 囲 全 をそれどれFor 角, に 変 換 ) します 変 換 Next 関 数 文 です で 処 理 します s.valueを 半 角 に 変 換 します s.valueを 大 文 字 に 変 換 します s.valueを 小 文 字 に 変 換 します Bに 含 まれる 全 てのAを 順 次 処 理 する シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 9/

10 様 式 後 Z157 処 理 版 発 行 年 月 日 このままですとエクセルを 違 追 うエクセルファイルを 加 したメニューの 閉 じた 時 消 メニューを 去 開 いた 終 了 時 しても 消 メニューだけ 去 するプログラムを 追 加 したメニューが 残 ってしまっています 追 加 標 し 準 元 バー メニューバーに の 状 態 に 戻 しましょう 残 ってしまいます Sub Dim ' 終 On Auto_close() Set 了 Error 時 の 自 Resume As = 動 Application.CommandBars("Worksheet 実 行 Next マクロでメニューを 消 します Dim Application.CommandBars(" mycb.controls(" As 追 加 1").Delete 小 道 具 ").Delete Menu Bar") End Set SubxlAPP mycb = Nothing アドインへ これで ファイルを アドインの 登 録 閉 じるとメニューが 消 去 されメニュー 追 加 前 の 状 態 に 戻 ります 追 加 1.xlaと 登 録 言 はファイル- うファイルが 出 名 来 前 ますので これをアドインとして を 付 けて 保 存 でファイルの 種 類 読 を み 込 *.xla みます で 保 存 します シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 10/

11 様 式 Z157 アドインの 読 み 込 みは み メニューの ツール-アドインをクリックし 版 発 行 年 月 日 アドインの つければ ここに 無 い 完 登 場 了 録 合 です した は 追 参 加 照 1にチェックマークを フォルダーへ 下 さい 移 動 しファイルを ボタンで 選 択 登 して 録 した シチズンセイミツ 株 式 会 社 文 書 番 号 02/(Z0R501) 頁 11/