Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2013)
userformでのlabelの判別
投稿日時: 19/09/01 11:43:42
投稿者: tomisuke

userformでカレンダーを作成し、カレンダーで指定した日付をセルに表示させようとしています。
 
userformでは42個のlabel(1行に7個の配列を5行で配置)を配置し、そのlabelにその月の日付を振り当てており背景色を平日・土曜・日曜で変更しています。
また選択した日付は背景色が変わるように設定しました。
 平日:RGB(235, 235, 255)
 土曜:RGB(200, 225, 255)
 日曜:RGB(255, 255, 255)
 選択日:RGB(200, 255, 200)
 
1日のみを選択させたいのですが、このままでは複数の日付を選択できてしまうために困っています。
選択日が2個ある以上の場合にMsgBoxで注意を促したいのですが、背景色の個数を数える様な方法はあるのでしょうか?
またはそれ以外に良い方法はあるのでしょうか?
 
どうにかお力を貸していただけないかと思い、質問させていただきました。
よろしくお願い致します。
 
今のところ、全く選択していない場合にはMsgBoxを表示させて選択するように促しています。
1日のみを選択している場合にはセルに表示させることはできています。
 
いろいろなサイトを見ながら試行錯誤をで行っているために、意味のない記述などがあると思いますが、よろしくお願い致します。
 
Private current_date As Date
Private accept_date As Date
Private cntrol_type As String
 
Private Sub UserForm_Activate()
DateLabel = Format(Date, "yyyy年m月")
current_date = Date
Call createDays
End Sub
 
Private Sub CommandButton1_Click()
    current_date = DateAdd("m", 1, current_date)
    DateLabel.Caption = Format(current_date, "yyyy年m月")
    Call createDays
End Sub
 
Private Sub CommandButton2_Click()
    current_date = DateAdd("m", -1, current_date)
    DateLabel.Caption = Format(current_date, "yyyy年m月")
    Call createDays
End Sub
 
Private Sub CommandButton3_Click()
  Dim i As Integer
 
  For i = 1 To 42
    If Me.Controls("Label" & i).BackColor = RGB(200, 255, 200) Then
        d = Me.Controls("Label" & i).Caption
         If d = "" Then
             MsgBox "当直日を選んでください"
         Else
           Windows("当直日報(0件用).xlsm").Activate
              ActiveSheet.Unprotect
 
                ActiveSheet.Range("F4").Value = CalendarForm.DateLabel.Caption & d & "日"
         End If
    End If
  Next
   
  If Workbooks("当直日報(0件用).xlsm").Worksheets("  業務日報  ").Range("F4") = "" Then
       MsgBox "当直日を選んでください"
  End If
 
End Sub
 
Sub createDays()
    Dim cal_date As Date
     
    current_month = Month(current_date)
    DateLabel.Caption = Format(current_date, "yyyy年" & "m月")
    'w = Weekday(current_date)
 
    Call clearDateLabel
    cal_date = Format(current_date, "yyyy/m") & "/1"
    w = Weekday(cal_date)
    cnt = 1
    For Each ctl In Controls
        If TypeName(ctl) = "Label" Then
            If cnt >= w Then
                ctl.Caption = Day(cal_date)
                If Year(accept_date) = Year(cal_date) And Month(accept_date) = Month(cal_date) And Day(accept_date) = Day(cal_date) Then
                  ctl.BackColor = RGB(190, 200, 255)
                End If
                cal_date = cal_date + 1
                If Month(cal_date) <> current_month Then Exit For
            End If
            cnt = cnt + 1
        End If
    Next
 
End Sub
 
 
Sub clearDateLabel()
    For Each ctl In Controls
        ctl.BackColor = RGB(235, 235, 255)
        If ctl <> DateLabel Then
            If TypeName(ctl) = "Label" Then ctl.Caption = ""
        End If
    Next
    DateLabel.BackColor = RGB(255, 255, 255)
    Label1.BackColor = RGB(255, 225, 225)
    Label8.BackColor = RGB(255, 225, 225)
    Label15.BackColor = RGB(255, 225, 225)
    Label22.BackColor = RGB(255, 225, 225)
    Label29.BackColor = RGB(255, 225, 225)
    Label36.BackColor = RGB(255, 225, 225)
     
    Label7.BackColor = RGB(200, 225, 255)
    Label14.BackColor = RGB(200, 225, 255)
    Label21.BackColor = RGB(200, 225, 255)
    Label28.BackColor = RGB(200, 225, 255)
    Label35.BackColor = RGB(200, 225, 255)
    Label42.BackColor = RGB(200, 225, 255)
 
End Sub
 
Private Sub Label2_Click()
  Select Case True
   Case Label2.BackColor = RGB(235, 235, 255)
      Label2.BackColor = RGB(200, 255, 200)
 
   Case Label2.BackColor = RGB(255, 225, 225)
      Label2.BackColor = RGB(200, 255, 200)
       
   Case Label2.BackColor = RGB(200, 225, 255)
      Label2.BackColor = RGB(200, 255, 200)
 
   Case Label2.BackColor = RGB(200, 255, 200)
          If Label9.BackColor = RGB(235, 235, 255) Then
               Label2.BackColor = RGB(235, 235, 255)
 
          ElseIf Label9.BackColor = RGB(255, 225, 225) Then
               Label2.BackColor = RGB(255, 225, 225)
       
          ElseIf Label9.BackColor = RGB(200, 225, 255) Then
               Label2.BackColor = RGB(200, 225, 255)
          End If
  End Select
 
End Sub
 
Private Sub Label3_Click()
  Select Case True
   Case Label3.BackColor = RGB(235, 235, 255)
      Label3.BackColor = RGB(200, 255, 200)
 
   Case Label3.BackColor = RGB(255, 225, 225)
      Label3.BackColor = RGB(200, 255, 200)
       
   Case Label3.BackColor = RGB(200, 225, 255)
      Label3.BackColor = RGB(200, 255, 200)
 
   Case Label3.BackColor = RGB(200, 255, 200)
          If Label10.BackColor = RGB(235, 235, 255) Then
               Label3.BackColor = RGB(235, 235, 255)
 
          ElseIf Label10.BackColor = RGB(255, 225, 225) Then
               Label3.BackColor = RGB(255, 225, 225)
       
          ElseIf Label10.BackColor = RGB(200, 225, 255) Then
               Label3.BackColor = RGB(200, 225, 255)
          End If
  End Select
 
End Sub

回答
投稿日時: 19/09/01 15:20:57
投稿者: 半平太

>1日のみを選択させたいのですが、
>このままでは複数の日付を選択できてしまうために困っています
 
ご提示のコードを読む気は起きないですが、、、
 
日付が選択されたら、そのラベル名をどこか(※)にメモっておけばいいんじゃないですか?
※ 例、Userformのキャップション
 
次回、別の日付が選択されたら、メモってあった名前のラベルコントロールを元の状態に戻し、
新しいラベル名をメモする。(これで複数になることはないでしょう)

回答
投稿日時: 19/09/01 17:40:41
投稿者: WinArrow
投稿者のウェブサイトに移動

 
コード非常にわかりにくい。
  
背景色で選択したかを判断させるではなく、
 別のコントロールを使うとか
例えば、トグルボタンを使うとValueのON/OFFで判断可能。
また、背景色も勝手に変わってくれる。
  
または、曜日は文字色で表現するとか
  
コントロールの名前も、わかりやすい名前にした方がよし、
 色もRGBではなく、
Const 白 AS Long = vbwhite
   
なんて書き方をすると、わかりやすくなると思いますが・・・
 
 
1つしか選択したことにするならば、半平太さんのレスが参考になりますが、
 
どうしてもカウントしたければ
Tagプロパティを使う方法があります。
選択したら:1
解除したら:0
とすれば、Tagを単純に足せばよい。
 
ところで、選択解除って、どのような操作になるのでしょうか?
 
  
 

投稿日時: 19/09/01 23:12:01
投稿者: tomisuke

いろいろと分かり難く、申し訳ありませんでした。
userform内で判別するのではなく、セルに日付を送ったかどうかで判別することにして解決できました。
皆様のご意見ありがとうございました。
いろいろなサイトを見ながらの試行錯誤で行っている為に分かり難くすみませんでした。
次回またよろしくお願い致します。
ありがとうございました。