プロが教える店舗&オフィスのセキュリティ対策術

よろしくお願いいたします。
上司からの依頼で困っています。

添付のような、マクロボタンを設定し、

・登録ボタンを押したら該当時間の下の表のセルが塗りつぶされる
・削除ボタンを押したら削除される
・表のセルをクリックしたら、名前、内容などが表示される

ように、することは可能でしょうか?

マクロは初心者ですが絶対に完成させろといわれてしまいました。。。

そもそも、このような作りこみは可能でしょうか?
ちなみに、この表は数人が共有して使う予定です。

以上、お願いいたします。

「excelで会議室予約表の作成(マクロ)」の質問画像

A 回答 (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

あと、登録と削除ですが、こちらは次回とさせてください。
ちょっと難しかったですか?

この回答への補足

ご丁寧にありがとうございます!
難しいですが、まずはやってみます。
表示はコメントで大丈夫です。

補足日時:2011/05/24 08:53
    • good
    • 2
この回答へのお礼

ありがとうございました。
お陰様でなんとか形になりました。

本当にご丁寧に、助かりました。

お礼日時:2011/05/27 16:18

前回の続きで、登録と削除です。


どちらもボタンのクリックイベントです。
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日から記入できるよう改造してください。
では検討を祈ります。
    • good
    • 1

セキュリティの関係で画像は見えませんが、


物理的な機能は可能です。
但し、会議室予約では最低限、次の情報が
必要です。
(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」
と、表示されるような感じです。 

補足日時:2011/05/23 13:08
    • good
    • 2

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています