- ベストアンサー
excelで会議室予約表の作成(マクロ)
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
>表のセルをクリックしたら、名前、内容などが表示される これ難しいですよ。一つのセルに複数の情報を突っ込む のは見苦しいし、かと言って他にデータを保存できる場所は 無くはありませんが、取り扱いが面倒です。そこで、セルの コメントにしてはどうでしょう。コメントならマウスポインタが 移動しただけで、自動的に表示/消去されますし、扱いも 簡単です。上司にネゴして了解してもらってください。 (1)次のシートを用意します。 人名シート:A1、A2、・・・に利用者名が記録される。 ここには領域名(例えば「利用者リスト」)を付ける。 原紙シート:年月別の記録シートのコピー元(不可視) (2)原紙シートには以下のコントロールを配置します。 コンボボックス:入力者 ネタ(利用者リスト)の設定方法は分かりますよね。 テキストボックス:備考 コマンドボタン:登録 コマンドボタン:削除 コマンドボタン:シート追加 使用日と時間は予め該当するセルを選んでおきます。 画像で言うと、B11:D11を選択してから登録すると、 m/01の08:00~09:30という具合です。 先ず、シートの追加から考えます。 Private Sub シート追加_Click() Dim シート数 As Long Dim 対象年月 As Text Dim 年月 As Date Dim シート As WorkSheet Dim エラー As Long 'シート数を求める シート数 = ThisWorkbook.WorkSheets.Count 'もし2シートなら対象年月を入力させる If シート数 < 3 Then 対象年月 = InputBox("対象年月をyyyy/mm形式で入力します", _ "年月の指定") 'キャンセル時は終了する If 対象年月 = "" Then Exit Sub '形式を調べる If Not IsDate(対象年月 & "/01 00:00:00") Then MsgBox "対象年月が間違っています", vbCritical, "エラー" Exit Sub End If '日付に変換する 年月 = CDate(対象年月 & "/01") Else '最後のシートの名前から日付に変換する 対象年月 = ThisWorkbook.WorkSheets(シート数).Name '日付に変換する 年月 = CDate(対象年月 & "/01") '翌月にする 年月 = DateAdd("M", 1, 年月) End If 'シート名を編集する 対象年月 = Format(年月, "yyyy-mm") '最終シートを取得する Set シート = ThisWorkbook.WorkSheets(シート数) 'コピーする On Error Resume Next ThisWorkbook.WorkSheets("原紙シート").Copy After:=シート エラー = Err.Number On Error GoTo 0 'エラーなら終了する If エラー <> vbNormal Then MsgBox "シートが多過ぎます", vbCritical, "エラー" Exit Sub End If '最後のシートを取得する Set シート = ThisWorkbook.WorkSheets(シート数 + 1) '名前を変更する シート.Name = 対象年月 End Sub あと、登録と削除ですが、こちらは次回とさせてください。 ちょっと難しかったですか?
その他の回答 (2)
- nda23
- ベストアンサー率54% (777/1415)
前回の続きで、登録と削除です。 どちらもボタンのクリックイベントです。 Private Sub 登録_Click() Dim IX As Long Dim 数 As Long Dim 行 As Long Dim 名 As String Dim 記 As String '複数行になっていたらエラー If Selection.Rows.Count > 1 Then MsgBox "複数行は選択できません", vbCritical, "エラー" Exit Sub End If '行位置を取得する 行 = Selection.Row '行位置の有効性を調べる If Me.Cells(行, 1) = "" Then MsgBox "指定行は無効です", vbCritical, "エラー" Exit Sub End If '列数を求める 数 = Selection.Columns.Count '左端が有効範囲か調べる IX = Selection.Columns(1).Column If IX >= 2 And IX <= 27 Then '右端が有効範囲か調べる IX = Selection.Columns(数).Column End If If IX < 2 Or IX > 27 Then MsgBox "選択列が有効範囲外です", vbCritical, "エラー" Exit Sub End If '先約がないか調べる For IX = 1 To 数 If Selection(IX).Interior.ColorIndex <> xlNone Then Exit For Next If IX <= 数 Then MsgBox "予約済みの時間帯を含みます", vbCritical, "エラー" Exit Sub End If '人名が空欄か調べる 名 = 入力者.Text If 名 = "" Then MsgBox "入力者が空欄です", vbCritical, "エラー" Exit Sub End If '備考が空欄か調べる 記 = 備考.Text If 記 = "" Then MsgBox "備考が空欄です", vbCritical, "エラー" Exit Sub End If '背景色を塗る Selection.Interior.ColorIndex = 44 '★色は適宜直す 'コメントを設定する For IX = 1 To 数 On Error Resume Next Selection(IX).Comment.Delete On Error GoTo 0 Selection(IX).AddComment 名 & vbNewLine & 記 Next End Sub '★====================================== Private Sub 削除_Click() Dim IX As Long Dim 数 As Long Dim 行 As Long '複数行になっていたらエラー If Selection.Rows.Count > 1 Then MsgBox "複数行は選択できません", vbCritical, "エラー" Exit Sub End If '行位置を取得する 行 = Selection.Row '行位置の有効性を調べる If Me.Cells(行, 1) = "" Then MsgBox "指定行は無効です", vbCritical, "エラー" Exit Sub End If '列数を求める 数 = Selection.Columns.Count '左端が有効範囲か調べる IX = Selection.Columns(1).Column If IX >= 2 And IX <= 27 Then '右端が有効範囲か調べる IX = Selection.Columns(数).Column End If If IX < 2 Or IX > 27 Then MsgBox "選択列が有効範囲外です", vbCritical, "エラー" Exit Sub End If '背景色を初期値にする Selection.Interior.ColorIndex = xlNone 'コメントを削除する For IX = 1 To 数 On Error Resume Next Selection(IX).Comment.Delete On Error GoTo 0 Next End Sub 尚、シート追加時に1列目に日にちを入れるのを 忘れてました。1日から記入できるよう改造してください。 では検討を祈ります。
- nda23
- ベストアンサー率54% (777/1415)
セキュリティの関係で画像は見えませんが、 物理的な機能は可能です。 但し、会議室予約では最低限、次の情報が 必要です。 (1)開始日時(2)終了日時、あるいは使用時間 (3)会議室がの番号(4)予約した人 日付や会議室別にシートを分けるとか、Excelの Userから予約者の名前を取得する等の方法が 考えられるのですが、その辺の仕様がハッキリ しないとソースを提示できませんね。
補足
ご回答ありがとうございます、補足します。 入力するのは ・入力者(プルダウンが望ましい) ・日付 ・開始時間 ・終了時間 ・内容 です。 会議室は1つのみで、月毎にシートを分けます。 例えば、 佐藤 6/1 8:00~8:30 打ち合わせ と、入力した場合 8:00 8:30 9:00 ・・・ ---------- 6/1|■■■■■| | ---------- 6/2| | | ---------- と、なり、且つ、塗られた部分をクリックしたら 「佐藤、打ち合わせ、8:00~8:30」 と、表示されるような感じです。
お礼
ありがとうございました。 お陰様でなんとか形になりました。 本当にご丁寧に、助かりました。
補足
ご丁寧にありがとうございます! 難しいですが、まずはやってみます。 表示はコメントで大丈夫です。