VBAで年月日から日曜日に当たる日の文字を赤くする方法

このQ&Aのポイント
  • VBAを使用して、指定した年月日が日曜日に当たる場合に、該当する日の文字を赤くする方法について質問があります。
  • 質問者は、TextBox2に年号(西暦)、ComboBox1に月、TextBox7に日を入力し、Label1からLabel31を押下して、日付けを入力したいと述べています。
  • さらに、ComboBoxで日付けをダウンリスト表示する方法についても質問者は知りたいとしています。
回答を見る
  • ベストアンサー

VBA 年月日から日曜日に当たる日の文字を赤くする

よろしくお願いします。 TextBox2に年号(西暦) ComboBox1に月 TextBox7に日 を、入力します。 入力方法は、Label1からLabel31を押下して日付けを入れます。 したときに各Labelの内、日曜日に該当するLabelならCaptionの文字を赤くする。 Private Sub Label1_Click() TextBox7.Value = 1 ’もし1日が日曜日ならLabel1のCaptionの文字を赤くする End Sub Private Sub Label2_Click() TextBox7.Value = 2 End Sub Private Sub Label3_Click() TextBox7.Value = 3 End Sub ~ Private Sub Label29_Click() TextBox7.Value = 29 End Sub Private Sub Label30_Click() TextBox7.Value = 30 End Sub Private Sub Label31_Click() TextBox7.Value = 31 End Sub 追 ComboBoxで日付けをダウンリスト表示したかったのですが、1列表示で 長くなってしまいます。 ※2列に表示する方法を知らないもので、Labelで2列表示にしました。 もし、ダウンリストを2列表示できるのであれば、ぜひともご教示をお願いします。 無識なものですみません。 何卒宜しくお願い致します。

  • 1211M
  • お礼率54% (90/165)

質問者が選んだベストアンサー

  • ベストアンサー
回答No.5

【別解】カレンダー描画時に色を設定する! Option Compare Database Private Sub Form_Load()   Me.年 = Year(Date)   Me.月 = Month(Date)   Me.日 = Day(Date)   ViewMyCalender Me.年, Me.月 End Sub Private Sub ViewMyCalender(ByVal intYear As Integer, ByVal intMonth As Integer)   Dim I    As Integer   Dim J    As Integer   Dim W    As Integer   Dim strName As String   Dim strDate As String   Dim dteDate As Date      strDate = Format(intYear, "0000") & "/" & _        Format(intMonth, "00") & "/" & _        "01"   W = GetWeekday(strDate)   For I = 1 To 37     strName = "日付_" & Format(I, "00")     If I >= W Then       Me.Controls(strName).Caption = I - W + 1       strDate = Format(intYear, "0000") & "/" & _            Format(intMonth, "00") & "/" & _            Format(I - W + 1, "00")       J = GetWeekday(strDate)       If J > 0 Then         Me.Controls(strName).ForeColor = IIf(J = 1, 255, 0)       Else         Me.Controls(strName).Caption = ""       End If     Else       Me.Controls(strName).Caption = ""     End If   Next I End Sub  このように、カレンダーを描画する際に日付の前景色を設定するのもありです。もちろん、添付図のようにカレンダー形式で配置して場合には、最初から日曜日は朱記するのでワザワザ設定することはないと思います。  添付図は、上記のコードを持つフォームを表示した場合のそれです。

1211M
質問者

お礼

f_a_007 様 お力添えありがとうございました。 解決しました。 今後もよろしくお願いします。

その他の回答 (6)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.7

>ComboBoxで日付けをダウンリスト表示したかったのですが >2列に表示する方法を知らないもので 1つのユーザーフォーム上に、左右に1つずつ2個のコンボボックスを配置し、 各コンボのリストの中身を、各々1-15日、16-31日にすれば済むことでしょう。しかしどちらのコンボをクリックすると、その期間の日々が出てくるかは、常識的に使い慣れていないので、キャプションでも付けて、判るようにしないと、使う人は戸惑うのではないか。 >日曜日に当たる日の文字を赤くする は年、月、日から、関数で日付シリアル値を導出し、Weekday関数を用いて、日曜日を判定し、コンボのその日付の特定行だけ、行の地の色を赤にすればよい。 しかしエクセルのユーザーフォームのコンボボックスの指定行を選択するVBAのコードが(WEB記事をしらべたが)見つからなかった。  だからラベルでも31個か30個(小の月)並べて、該当の日にちのラベルの色を赤くするほかない。 しかし最も難点は、そのラベルをクリックしたものがどれかを、31日分のクリックイベントコードを書かないで、割り出すコードがむつかしいのです。 ExcelVBAでは、コントロール配列が使えず、日ごろ使い慣れない、クラスの利用になったりするからです。 また、2013、2016では、DateTimePickerも使うのは大変(敷居が高い)のようだ。 ーー 日も(コンボ出なくて)テキストボックスに入力させる方法が、良いのでは。

  • HohoPapa
  • ベストアンサー率65% (454/690)
回答No.6

日付を入力、あるいは選択させるインターフェースは、 スプレッドシートにせよ、フォームにせよ、 基本機能だけでスマートに実装するのはなかなか手強いです。 私は多くの場合 http://www.asahi-net.or.jp/~ef2o-inue/download/sub09_020_025.html のコードを使っています。 一見難解でハードルが高そうですが 使うだけなら難しくありません。 それでもよくわからなければ、 課題サイトの最下行にあるダウンロードボタンで マクロブックをダウンロードし、 これをベースに作り上げるという対応でも大丈夫です。 よかったら挑戦してみてください。 なお、このサイトと私は無関係です。

回答No.4

Option Compare Database Private Sub Form_Load()   Me.年 = Year(Date)   Me.月 = Month(Date)   Me.日 = Day(Date)   ViewMyCalender Me.年, Me.月   UpdateWeekdayColor Me.年, Me.月 End Sub Private Sub UpdateWeekdayColor(ByVal strYear As String, ByVal strMonth As String)   Dim I     As Integer   Dim strName  As String   Dim strYYYYMM As String   Dim strDate  As String      strYYYYMM = strYear & "/" & strMonth   For I = 1 To 37     strName = "日付_" & Format(I, "00")     strDate = strYYYYMM & "/" & Me.Controls(strName).Caption     Me.Controls(strName).ForeColor = IIf(GetWeekday(strDate) = 1, 255, 0)   Next I End Sub  添付図のカレンダーの日付の色は、上記のコードで決定しています。For-Next文で前景色を変更することを想定して、日付を表示するラベルコントロールの名前は、”日付_XX”としています。  UpdateWeekdayColor()はフォームロード時にコールしていますが、当然に、年月をチェンジしたら再表示する為にコールすることになります。  GetWeekday()は、このように利用します。

回答No.3

【訂正の訂正】修正ミスでした! Public Function GetWeekday(ByVal strDate As String) As Integer On Error GoTo Err_GetWeekDay Dim intWeekday As Integer intWeekday = Weekday(CDate(strDate)) Exit_GetWeekDay: GetWeekday = intWeekday Exit Function Err_GetWeekDay: On Error GoTo 0 Resume Exit_GetWeekDay End Function PS、実は、次のコードでも同じ結果を得られます。 Public Function GetWeekday2(ByVal strDate As String) As Integer On Error Resume Next   GetWeekday2 = Weekday(CDate(strDate)) End Function

1211M
質問者

補足

f_a_007 様 早速の回答ありがとうございます。 このコードはどこに記したらよいのでしょうか。 無識ですみません。

回答No.2

訂正:dteDate = strDateは無用でした。 Public Function GetWeekday(ByVal strDate As String) As Integer On Error GoTo Err_GetWeekDay   Dim intWeekday As Integer      intWeekday = Weekday(CDate(dteDate)) Exit_GetWeekDay:   GetWeekday = intWeekday   Exit Function Err_GetWeekDay:   On Error GoTo 0   Resume Exit_GetWeekDay End Function

回答No.1

Public Function GetWeekday(ByVal strDate As String) As Integer On Error GoTo Err_GetWeekDay   Dim intWeekday As Integer      dteDate = strDate   intWeekday = Weekday(CDate(dteDate)) Exit_GetWeekDay:   GetWeekday = intWeekday   Exit Function Err_GetWeekDay:   On Error GoTo 0   Resume Exit_GetWeekDay End Function  GetWeekday() をイミディエイトウインドウでテストすると・・・ 【イミディエイトウインドウ】 >GetWeekday("2018/12/01") 7 >GetWeekday("2018/12/02") 1 >GetWeekday("2018/12/99") 0 と、正しい日付を受け取った時は、1~7の曜日を示す値を返します。エラーが発生した時には0を戻します。質問の案件を解決するには、このGetWeekday()を利用するといいでしょう。 【検討事項1】年と月が確定した時点で日付をセットする。  その時に、添付図のように並べると曜日で文字色を変える必要はない。何等かの事情で、フォームに横一列で並べるのであれば、その際に文字色をGetWeekday()を利用してセットする。なお、ラベルの名前を"日付_01"、"日付_02"・・・"日付_35"とすれば、For-Nextでセットできると思います。 【検討事項2】ラベルクリックイベントを書かない策も・・・。  問題は、最低で31個、最高37個のラベルコントロールのどれがクリックされたかをキャッチし《日付》を更新しなければならない点です。ここは、全てのラベルコントロールに共通するクリックイベントを発生させて目的を達成させたいもの。ただし、この件は、別に質問されたがいいです。タイトルは、「共通するイベントを発生させるには?」などで・・・。  フォーム画面が示されていませんので、ここら辺りで・・・

関連するQ&A

  • エクセルVBA 計算の繰り返し処理?

    エクセルのVBA フォーム内にて 下記、各テキストボックスの数値を変更することにより Label27にLabel28*TextBox12+TextBox13+TextBox14 Label33にLabel34*TextBox16+TextBox17+TextBox18 Label27、Label33に計算の答えを書き込みたいため 下記のように書き込みました。 Private Sub TextBox12_Change() Label27.Caption = Val(Label28.Caption) * Val(TextBox12.Value) _ + Val(TextBox13.Value) + Val(TextBox14.Value) End Sub Private Sub TextBox13_Change() Label27.Caption = Val(Label28.Caption) * Val(TextBox12.Value) _ + Val(TextBox13.Value) + Val(TextBox14.Value) End Sub Private Sub TextBox14_Change() Label27.Caption = Val(Label28.Caption) * Val(TextBox12.Value) _ + Val(TextBox13.Value) + Val(TextBox14.Value) End Sub Private Sub TextBox16_Change() Label33.Caption = Val(Label34.Caption) * Val(TextBox16.Value) _ + Val(TextBox17.Value) + Val(TextBox18.Value) End Sub Private Sub TextBox17_Change() Label33.Caption = Val(Label34.Caption) * Val(TextBox16.Value) _ + Val(TextBox17.Value) + Val(TextBox18.Value) End Sub Private Sub TextBox18_Change() Label33.Caption = Val(Label34.Caption) * Val(TextBox16.Value) _ + Val(TextBox17.Value) + Val(TextBox18.Value) End Sub 計算は出来るのですが計算ラベル50程あるため、修正を考えて ももう少し簡素化して書き込みたいため 調べましたがヒント項目がずれているせいか回答を検索できませんでした。 どのようにすれば宜しいかご教示の程宜しくお願いいたします。

  • VBA DoEvents関数の働きと使い方を知りたい

    下記のような UserForm上の Module コードを書いてももらったのですが、DoEvents の働きが分からないのです。どなたか分かりやすく説明していただけませんでしょうか? Private i As Integer Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.TextBox1.Value = Me.Label1.Caption Then Me.Label2.Caption = "正解です" Else Me.Label2.Caption = "不正解です" End If DoEvents If i < 20 Then i = i + 1 Label_Up Me.TextBox1.Value = "" Cancel = True Else MsgBox "終了です" End If End Sub Private Sub UserForm_Initialize() i = 1 Label_Up End Sub Private Sub Label_Up() Me.Label1.Caption = Sheets("Sheet1").Range("A1:A20").Cells(i).Value DoEvents End Sub

  • LabelとTextboxの自動計算を希望

    ComboBox2のリスト選択で連動でlabel2とlabel12の数字変更 TextBox2には数字入力 Label12(数字) x TextBox2(数字) = Lavel22(乗算合計)で Label12変えないで、TextBox2の数字変えた時はLabel22の合計変動 Label12の数字変えて、TextBox2の数字変ない時はLabel22の合計変わらない現状です。 Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Select Case True 'TextBox2かLabel12が空白の時Label22空白 Case TextBox2.Value = "" Or Label12.Caption = "" Label22.Caption = "" Case Else 'TextBox2とLabel12が数字の時Label22はTextBox2の数字とLabel12数字を乗算する If IsNumeric(TextBox2.Value) And IsNumeric(Label12.Caption) Then _ Label22.Caption = TextBox2 * Label12 'Label22に数字がある時Label29に合計表示 Label29.Caption = Label22 End Select End Sub ComboBox2_change()作って、TextBox2_KeyUp書いてる内容を書けば動くでしょうが・・・ 同じ内容2つ書かないで動く方法があれば非常に助かります。 いい方法無さそうならComboBox2_change()作って書こうかな・・・と思ってます

  • VBAプログラムについて

    VBAプログラムを本を見ながら作成していますが、はっきりいって素人です。 本に載っていないこととなるとちんぷんかんぷんで、いくつかあるプロシージャのどのプロシージャ内に記入したら良いのか分からないし、新しいプロシージャをどこに記入して良いのか分かりません。 例えば、 ----------------------------------------------------------- Private Sub CommandButton1_Click() ActiveCell.Value = TextBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value ActiveCell.Offset(0, 3).Value = TextBox4.Value ActiveCell.Offset(0, 4).Value = TextBox5.Value ActiveCell.Offset(0, 5).Value = TextBox6.Value ActiveCell.Offset(0, 6).Value = TextBox7.Value ActiveCell.Offset(0, 7).Value = TextBox8.Value ActiveCell.Offset(0, 8).Value = TextBox9.Value ActiveCell.Offset(1, 0).Activate End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub Label1_Click() End Sub Private Sub UserForm_Click() End Sub Private Sub UserForm_Initialize() Range("A2").Activate End Sub ---------------------------------------------------------- テキスト入力フォームをいくつか作っており、コマンドボタン1とコマンドボタン2で入力ボタンと閉じるボタンにしています。   このプログラムでは、入力ボタンをクリックすることでデータが入力されて、入力された列のすぐ次の列の最初のセルがアクティブな状態になります。 (1)データ入力済みのエクセルシートにおいて、アクティブな状態にしたセルや列を削除したい場合、どこにどのように書けば良いのでしょうか? (2)データ入力が一度に終わらない時、途中の任意の列から入力を始めたい場合はどこにどのように書けば良いのでしょうか? 本に書かれていることは丸写しできますが、ちょっとでも違うと壁にぶつかってしまいます。 独学で勉強する時に良いと思われる方法はどんな方法なのでしょうか? おこがましいですが素人も分かりやすい説明をして頂けると助かります。 宜しくお願いします。

  • Visual Basic 6.0でのLabelについて質問です。

    Visual Basic 6.0でのLabelについて質問です。 今、Labelが100個あるとして、 どのラベルが押されても同じ処理をさせたい場合、どのようにプログラムを組めばよいかわかりません・・・ そこで、 Private Sub Label2_Click() Label1.Caption = "停止" End Sub Private Sub Label3_Click() Label1.Caption = "停止" End Sub Private Sub Label4_Click() Label1.Caption = "停止" End Sub    ・    ・    ・ Private Sub Label101_Click() Label1.Caption = "停止" End Sub のように100個繰り返しても良いのですが、だらだら長くなってしまうので、スマートに 処理できる方法を探しています。 もしご存知の方がいらっしゃいましたら教えていただけないでしょうか? よろしくお願いします。

  • ユーザーフォームをWorkSheet(1)に固定

    ●質問の主旨 WorkSheet(1)(「柴田8月分」)にユーザーフォームを固定的に 表示させつつ、WorkSheet(1)以降のWorkSheet(2)、 WorkSheet(3)、WorkSheet(4)の表を参照しながら ComboBox1、ComboBox2、ComboBox3にリストを 選択して、データベースに入力したいと考えています。 以下のコードをどのように書き換えれば良いでしょうか? ご教示のほどよろしくお願い申し上げます。 ●質問の補足 現在のコードでは、ComboBox1、ComboBox2、ComboBox3を それぞれ選択しているとユーザーフォームがそれぞれ WorkSheet(2)、WorkSheet(1)(顧客リスト)、WorkSheet(3)(社員名)、 WorkSheet(4)(大分類)にとんでしまいます。 転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。 その手作業を回避したいと考えています。 なお添付画像はComboBox1の選択前なのでWorkSheet(1) に留まってくれています。 ●コード Option Explicit 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With Set r = Nothing Set n = Nothing Set d = Nothing TextBox3.Value = Worksheets(1).Range("A2").Value + 1 txtdate = Date OptionButton1.Value = True End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() Worksheets(2).Select With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) Worksheets(2).Select Replace:=False End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() Worksheets(3).Select With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) Worksheets(3).Select Replace:=False End With End Sub 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets("柴田8月分") .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 Dim i As Long For i = 1 To 1 Step 1 TextBox3.Value = TextBox3.Value + 1 Next Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。

  • VB初心者です

    計算結果が"7"の時に限り、「当たり!」と表示される、ちょっと意味不明な計算機を作っています。 現在、下記のように書いてますが、何故かうまくいきません。(当たりが表示されない 何故でしょうか?お助けください。。m(_ _)m Private Sub Command1_Click() Label1.Caption = Str(Val(Text1.Text) + Val(Text2.Text)) Label3.Caption = "+" Label4.Visible = False '画像を隠す。 'いずれかの数字が「7」のとき、メッセージを表示する。 If Label1.Caption = "7" Then Label4.Visible = True End If End Sub Private Sub Command2_Click() End End Sub Private Sub Command3_Click() Label1.Caption = Str(Val(Text1.Text) * Val(Text2.Text)) Label3.Caption = "*" End Sub Private Sub Command4_Click() Label1.Caption = Str(Val(Text1.Text) - Val(Text2.Text)) Label3.Caption = "-" End Sub Private Sub Command5_Click() Label1.Caption = Str(Val(Text1.Text) / Val(Text2.Text)) Label3.Caption = "/" End Sub

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • コードの添削お願いします(変数エラー)

    Option Explicit Private Sub CommandButton1_Click() Dim myStr As String If myStr <> "" Then myStr = TextBox.Value Label1.Caption = LTrim(myStr) Label2.Caption = RTrim(myStr) Label3.Caption = Trim(myStr) Else MsgBox "終了" End If End Sub 変数のエラーが出ますが、何処がおかしいですか? 宜しくお願い致します。

  • VBA初心者です。

    VBA初心者です。 ユーザーフォームにテキストボックスとコンボボックスを1つずつ作り、それらを Private Sub ComboBox1_Change()    TextBox1.Value = ComboBox1.Value End Sub というふうに繋いでるとき、テキストボックスにフォーカスをあてさせないようするため、 Private Sub UserForm_Initialize()    TextBox1.Enabled = False End Sub このようにしました。ここまでは問題ありません。質問したいことは、このときテキストボックスに表示させる文字が淡色になるのを防ぐ方法です。    TextBox1.Locked = True これを上に付け加えればうまくいきそうなのですが、うまくいきませんでした…。どなたか解決方法を教えて下さい。

専門家に質問してみよう