[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『平成を令和に直したい』（とし）
このコードの中にどこを直せば平成から令和に修正できますか？
よろしくお願いします
コードです
Option Explicit
Dim MyDate As Date 'CommandButton1の月日（最初の月日）
Dim MyYear As Integer '選択した年
Dim MyMonth As Byte '選択した月
Dim MySetDate As Date, MyNextDate As Date '当月の1日と翌月の1日
Dim CBAdd As Range 'ComboBoxのソース
Dim MyWeekday As Byte '曜日のシリアル値
Dim i As Byte, MyCom As Byte 'ループカウント変数
Dim MySelsetDate As Date '選択した月日
Dim MyHName As String '祝日名
Dim MyCDate As Date '各CommandButtonの月日
Dim Fontobject As IFontDisp
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii.Value < 48 Or KeyAscii.Value > 57 Then KeyAscii.Value = 0
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
Call DateFix '日付を計算するプロシージャ呼び出し
Call MyDesign '書式の設定プロシージャ呼び出し
End Sub
Private Sub ComboBox2_Change()
Call DateFix '日付を計算するプロシージャ呼び出し
Call MyDesign '書式の設定プロシージャ呼び出し
End Sub
Private Sub Label8_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub SpinButton1_Change()
Dim MySpin1 As Integer
MySpin1 = Replace(ComboBox1.Value, "年", "")
If (MySpin1 = 2100 And SpinButton1.Value = 1) Or (MySpin1 = 1900 And SpinButton1.Value = -1) Then
SpinButton1.Value = 0
End If
Me.ComboBox1.Value = Format(MySpin1 + SpinButton1.Value, "0年")
SpinButton1.Value = 0
End Sub
Private Sub SpinButton2_Change()
Dim MySpin2 As Integer
MySpin2 = Replace(ComboBox2.Value, "月", "")
If (MySpin2 = 12 And SpinButton2.Value = 1) Or (MySpin2 = 1 And SpinButton2.Value = -1) Then
SpinButton2.Value = 0
End If
Me.ComboBox2.Value = Format(MySpin2 + SpinButton2.Value, "0月")
SpinButton2.Value = 0
End Sub
Sub UserForm_Initialize()
With Me
For Each CBAdd In Rows("1900:2100")
.ComboBox1.AddItem CBAdd.Row & "年"
Next CBAdd
For Each CBAdd In Rows("1:12")
.ComboBox2.AddItem CBAdd.Row & "月"
Next CBAdd
.ComboBox1.Value = Format(Date, "YYYY年")
.ComboBox2.Value = Format(Date, "M月")
End With
End Sub
Sub DateFix() 'コンボボックスの値によりカレンダーに日付を入れる
MyYear = Me.ComboBox1.ListIndex + 1900
If Me.ComboBox2.ListIndex = -1 Then
MyMonth = Format(Date, "M")
Else
MyMonth = Me.ComboBox2.ListIndex + 1
End If
MySetDate = DateSerial(MyYear, MyMonth, 1)
MyWeekday = MySetDate Mod 7
If MyWeekday = 0 Then
MyDate = MySetDate - MyWeekday + DateSerial(1900, 1, 1) - 8
Else
MyDate = MySetDate - MyWeekday + DateSerial(1900, 1, 1) - 1
End If
For i = 0 To 41 '全てのButtonに日付を入れる
MyCDate = MyDate + i
Call MyHoliday '休日の判定
With Me.Controls("CommandButton" & (1 + i))
Set Fontobject = .Font
.Caption = Format(MyCDate, "d") & vbCrLf & MyHName
If MyCDate = Date Then '開いたときに今日をアクティブにする
.TabIndex = 1
End If
If MyHName <> "" Then
Fontobject.Size = 7
Else
Fontobject.Size = 9
End If
End With
Next i
With Label8
.Caption = Format(MySetDate, "YYYY年M月")
.FontSize = 10
.FontBold = True
End With
With Label9
.Caption = Format(DateSerial(MyYear, MyMonth, 1), "GGGE年M月")
.FontSize = 9
.FontBold = True
Set Fontobject = Nothing
End With
End Sub
Sub MyDesign() '書式の設定
'月初の処理
For MyCom = 1 To 7
With Me.Controls("CommandButton" & MyCom)
Set Fontobject = .Font
If MySetDate > MyDate + (MyCom - 1) Then
Fontobject.Italic = True
If MyCom = 1 Then
.ForeColor = &H80FF& 'オレンジ
Else
If Len(.Caption) > 4 Then
.ForeColor = &H80FF& 'オレンジ
Else
.ForeColor = &H808080 '灰色
End If
End If
Else
Fontobject.Italic = False
Select Case MyCom
Case 1
.ForeColor = &HFF& '赤
Case 7
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &HFF0000 '青
End If
Case Else
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &H80000012 '黒
End If
End Select
End If
End With
Next MyCom
'中間の処理
For MyCom = 8 To 28
With Me.Controls("CommandButton" & MyCom)
Set Fontobject = .Font
Select Case MyCom
Case 8, 15, 22
.ForeColor = &HFF& '赤
Case 14, 21, 28
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &HFF0000 '青
End If
Case Else
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &H80000012 '黒
End If
End Select
End With
Next MyCom
'月末の処理
For MyCom = 29 To 42
With Me.Controls("CommandButton" & MyCom)
Set Fontobject = .Font
MyNextDate = DateSerial(MyYear, MyMonth + 1, 1)
If MyNextDate <= MyDate + (MyCom - 1) Then
Fontobject.Italic = True
Select Case MyCom
Case 29, 36
.ForeColor = &H80FF& 'オレンジ
Case 35, 42
If Len(.Caption) > 4 Then
.ForeColor = &H80FF& 'オレンジ
Else
.ForeColor = &HC0C000 '水色
End If
Case Else
If Len(.Caption) > 4 Then
.ForeColor = &H80FF& 'オレンジ
Else
.ForeColor = &H808080 '灰色
End If
End Select
Else
Fontobject.Italic = False
Select Case MyCom
Case 29, 36
.ForeColor = &HFF& '赤
Case 35, 42
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &HFF0000 '青
End If
Case Else
If Len(.Caption) > 4 Then
.ForeColor = &HFF& '赤
Else
.ForeColor = &H80000012 '黒
End If
End Select
End If
End With
Next MyCom
Set Fontobject = Nothing
End Sub
Private Sub CommandButton1_Click()
MySelsetDate = MyDate + 0
Call MyCommnd
End Sub
Private Sub CommandButton2_Click()
MySelsetDate = MyDate + 1
Call MyCommnd
End Sub
Private Sub CommandButton3_Click()
MySelsetDate = MyDate + 2
Call MyCommnd
End Sub
Private Sub CommandButton4_Click()
MySelsetDate = MyDate + 3
Call MyCommnd
End Sub
Private Sub CommandButton5_Click()
MySelsetDate = MyDate + 4
Call MyCommnd
End Sub
Private Sub CommandButton6_Click()
MySelsetDate = MyDate + 5
Call MyCommnd
End Sub
Private Sub CommandButton7_Click()
MySelsetDate = MyDate + 6
Call MyCommnd
End Sub
Private Sub CommandButton8_Click()
MySelsetDate = MyDate + 7
Call MyCommnd
End Sub
Private Sub CommandButton9_Click()
MySelsetDate = MyDate + 8
Call MyCommnd
End Sub
Private Sub CommandButton10_Click()
MySelsetDate = MyDate + 9
Call MyCommnd
End Sub
Private Sub CommandButton11_Click()
MySelsetDate = MyDate + 10
Call MyCommnd
End Sub
Private Sub CommandButton12_Click()
MySelsetDate = MyDate + 11
Call MyCommnd
End Sub
Private Sub CommandButton13_Click()
MySelsetDate = MyDate + 12
Call MyCommnd
End Sub
Private Sub CommandButton14_Click()
MySelsetDate = MyDate + 13
Call MyCommnd
End Sub
Private Sub CommandButton15_Click()
MySelsetDate = MyDate + 14
Call MyCommnd
End Sub
Private Sub CommandButton16_Click()
MySelsetDate = MyDate + 15
Call MyCommnd
End Sub
Private Sub CommandButton17_Click()
MySelsetDate = MyDate + 16
Call MyCommnd
End Sub
Private Sub CommandButton18_Click()
MySelsetDate = MyDate + 17
Call MyCommnd
End Sub
Private Sub CommandButton19_Click()
MySelsetDate = MyDate + 18
Call MyCommnd
End Sub
Private Sub CommandButton20_Click()
MySelsetDate = MyDate + 19
Call MyCommnd
End Sub
Private Sub CommandButton21_Click()
MySelsetDate = MyDate + 20
Call MyCommnd
End Sub
Private Sub CommandButton22_Click()
MySelsetDate = MyDate + 21
Call MyCommnd
End Sub
Private Sub CommandButton23_Click()
MySelsetDate = MyDate + 22
Call MyCommnd
End Sub
Private Sub CommandButton24_Click()
MySelsetDate = MyDate + 23
Call MyCommnd
End Sub
Private Sub CommandButton25_Click()
MySelsetDate = MyDate + 24
Call MyCommnd
End Sub
Private Sub CommandButton26_Click()
MySelsetDate = MyDate + 25
Call MyCommnd
End Sub
Private Sub CommandButton27_Click()
MySelsetDate = MyDate + 26
Call MyCommnd
End Sub
Private Sub CommandButton28_Click()
MySelsetDate = MyDate + 27
Call MyCommnd
End Sub
Private Sub CommandButton29_Click()
MySelsetDate = MyDate + 28
Call MyCommnd
End Sub
Private Sub CommandButton30_Click()
MySelsetDate = MyDate + 29
Call MyCommnd
End Sub
Private Sub CommandButton31_Click()
MySelsetDate = MyDate + 30
Call MyCommnd
End Sub
Private Sub CommandButton32_Click()
MySelsetDate = MyDate + 31
Call MyCommnd
End Sub
Private Sub CommandButton33_Click()
MySelsetDate = MyDate + 32
Call MyCommnd
End Sub
Private Sub CommandButton34_Click()
MySelsetDate = MyDate + 33
Call MyCommnd
End Sub
Private Sub CommandButton35_Click()
MySelsetDate = MyDate + 34
Call MyCommnd
End Sub
Private Sub CommandButton36_Click()
MySelsetDate = MyDate + 35
Call MyCommnd
End Sub
Private Sub CommandButton37_Click()
MySelsetDate = MyDate + 36
Call MyCommnd
End Sub
Private Sub CommandButton38_Click()
MySelsetDate = MyDate + 37
Call MyCommnd
End Sub
Private Sub CommandButton39_Click()
MySelsetDate = MyDate + 38
Call MyCommnd
End Sub
Private Sub CommandButton40_Click()
MySelsetDate = MyDate + 39
Call MyCommnd
End Sub
Private Sub CommandButton41_Click()
MySelsetDate = MyDate + 40
Call MyCommnd
End Sub
Private Sub CommandButton42_Click()
MySelsetDate = MyDate + 41
Call MyCommnd
End Sub
Sub MyCommnd() 'コマンドボタンをクリックしたときの処理
If vbYes = MsgBox(MySelsetDate & "を入力します。", vbYesNo, "確認") Then
ActiveCell.Value = Format(MySelsetDate, "YYYY/M/D")
End If
End Sub
Sub MyHoliday() '休日の判定処理
Select Case MyCDate
Case DateSerial(2004, 1, 1)
MyHName = "元日"
Case DateSerial(2004, 1, 12)
MyHName = "成人の日"
Case DateSerial(2004, 2, 11)
MyHName = "建国記念の日"
Case DateSerial(2004, 3, 20)
MyHName = "春分の日"
Case DateSerial(2004, 4, 29)
MyHName = "みどりの日"
Case DateSerial(2004, 5, 3)
MyHName = "憲法記念日"
Case DateSerial(2004, 5, 4)
MyHName = "国民の休日"
Case DateSerial(2004, 5, 5)
MyHName = "こどもの日"
Case DateSerial(2004, 7, 19)
MyHName = "海の日"
Case DateSerial(2004, 9, 20)
MyHName = "敬老の日"
Case DateSerial(2004, 9, 23)
MyHName = "秋分の日"
Case DateSerial(2004, 10, 11)
MyHName = "体育の日"
Case DateSerial(2004, 11, 3)
MyHName = "文化の日"
Case DateSerial(2004, 11, 23)
MyHName = "勤労感謝の日"
Case DateSerial(2004, 12, 23)
MyHName = "天皇誕生日"
Case DateSerial(2005, 1, 1)
MyHName = "元日"
Case DateSerial(2005, 1, 10)
MyHName = "成人の日"
Case DateSerial(2005, 2, 11)
MyHName = "建国記念の日"
Case DateSerial(2005, 3, 20)
MyHName = "春分の日"
Case DateSerial(2005, 3, 21)
MyHName = "振替休日"
Case DateSerial(2005, 4, 29)
MyHName = "みどりの日"
Case DateSerial(2005, 5, 3)
MyHName = "憲法記念日"
Case DateSerial(2005, 5, 4)
MyHName = "国民の休日"
Case DateSerial(2005, 5, 5)
MyHName = "こどもの日"
Case DateSerial(2005, 7, 18)
MyHName = "海の日"
Case DateSerial(2005, 9, 19)
MyHName = "敬老の日"
Case DateSerial(2005, 9, 23)
MyHName = "秋分の日"
Case DateSerial(2005, 10, 10)
MyHName = "体育の日"
Case DateSerial(2005, 11, 3)
MyHName = "文化の日"
Case DateSerial(2005, 11, 23)
MyHName = "勤労感謝の日"
Case DateSerial(2005, 12, 23)
MyHName = "天皇誕生日"
Case DateSerial(2006, 1, 1)
MyHName = "元日"
Case DateSerial(2006, 1, 2)
MyHName = "振替休日"
Case DateSerial(2006, 1, 9)
MyHName = "成人の日"
Case DateSerial(2006, 2, 11)
MyHName = "建国記念の日"
Case DateSerial(2006, 3, 21)
MyHName = "春分の日"
Case DateSerial(2006, 4, 29)
MyHName = "みどりの日"
Case DateSerial(2006, 5, 3)
MyHName = "憲法記念日"
Case DateSerial(2006, 5, 4)
MyHName = "国民の休日"
Case DateSerial(2006, 5, 5)
MyHName = "こどもの日"
Case DateSerial(2006, 7, 17)
MyHName = "海の日"
Case DateSerial(2006, 9, 18)
MyHName = "敬老の日"
Case DateSerial(2006, 9, 23)
MyHName = "秋分の日"
Case DateSerial(2006, 10, 9)
MyHName = "体育の日"
Case DateSerial(2006, 11, 3)
MyHName = "文化の日"
Case DateSerial(2006, 11, 23)
MyHName = "勤労感謝の日"
Case DateSerial(2006, 12, 23)
MyHName = "天皇誕生日"
Case Else
MyHName = ""
End Select
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
.Caption = Format(DateSerial(MyYear, MyMonth, 1), "GGGE年M月")
どう直せばいいかは知りません。
（わからん） 2021/09/14(火) 16:06
参考まで。
http://www.excel.studio-kazu.jp/tips/0070/
（通りすがり） 2021/09/14(火) 16:13
（とし） 2021/09/14(火) 22:03
更新することが基本ですが、雑な対応としてはこんな感じ。
.Caption = WorksheetFunction.Substitute(Format(DateSerial(myyear, mymonth, 1), "GGGE年M月"), "平成3", "令和")
（平成3年、平成30年、平成31年の4月までと、令和10年以降の表示がおかしくなります）
（わからん） 2021/09/15(水) 08:14
通りすがりさんの提示してくれたページ内に
ただし下のケースは問題あり、個別に対応が必要です PCがネットに繋がっていない場合
Windows Update を正しく行なっていない場合、できない場合
独自に数式や関数や条件付き書式を使って [昭和] や [平成] に変換している場合
Excel や Windows のサポートが終了しているバージョンの場合
Excel2007 は 2017/10/10 でサポート終了、Excel2010 は 2020/10/13 にサポート終了予定
Windows Vista は 2017/04/11 でサポート終了、Windows7 は 2020/01/14 にサポート終了予定
対応例 → [[20190411103126]] の 5月6日 （KITA）さんの記述
とあるので試してみてはいかがでしょう。 （*） 2021/09/15(水) 09:24
>どこを直せば平成から令和に修正できますか？ ユーザーフォームの caption 表示ですか。 マクロ実行後のエクセルの令和表示ですか。
（OP） 2021/09/15(水) 18:09
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.