★一太郎マクロ初心者奮戦記★

簡易カレンダー作成マクロ

このサイトは「くまぷーのExcel道場」なのですがこの頃、とんとExcelが話題に上ってきません。すっかり、Excelから遠ざかってしまっています。

　さて一太郎Q&A掲示板を何気なく見たら、何やらくまぷーにも答えられそうな質問がありました。ここの掲示板には以前一度、回答をしました。一太郎に関する質問に回答するのは初めてだったので、ドキドキだったのですが質問者にほったらかしにされてしまい悲しかったのですが、マナーの悪い人ばかりではなかろうとついまた回答をしてしまいました。すると今度はすぐにレスが付いたのでニコニコです。

名称：簡易カレンダー作成マクロ

免責：このマクロの使用によっていかなる損害が生じようと、一切責任は負いません。あらかじめご承知の上ご使用下さい。

使用法：マクロを実行すると「範囲指定」が求められますので

平成19年2月

のような文字列を選択してください。
すると下のようにカレンダーが作られます。

ダウンロードはこちら

（2007/02/12)

ちなみに下が簡易カレンダー作成マクロのコードです。
プロポーショナルフォントだと数字がきちんと並ばないので最後にわざわざ範囲選択して等幅フォントに変えています。（コードNo.1）

!!（コードNo.1）

Range?()
%Str=GetString
%Nen=Mid(%Str(1) , 3 , 2)
%Tuki=Right(%Str(1),3)
If left(%Tuki,1) = "年" Or left(%Tuki,1) = " " Or left(%Tuki,1) = "　"Then
        %Tuki = Mid(%Tuki,2,1)
Else
        %Tuki = Left(%Tuki,2)
End If
%Nen = %Nen + 1988

%Pos=DayOfWeek( %Nen , %Tuki, 1 )
%Cnt=7-%Pos+1

下
行頭
%MyRow=GetRow
%MyCol=GetColumn
%MyPage=GetPage
Insert("日月火水木金土",1)
%Num={" 1"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9",10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}

!!閏年判定
%IsLeapYear=False
If %Nen Mod 4 =0 Then
        %IsLeapYear= True
End If
If %Nen Mod 100 =0 Then
        %IsLeapYear= False
End If
If %Nen Mod 400 =0 Then
        %IsLeapYear= True
End If

!!月末最終日
Select Case %Tuki
        Case 1,3,5,7,8,10,12
                %最終日        =31
        Case 4,6,9,11
                %最終日        =30
        Case 2
                If %IsLeapYear =True Then
                        %最終日        =29
                Else
                        %最終日        =28
                End If
End Select

Jump(,,(%Pos -1)* 3+1)

For %i = 1 to %最終日

        Insert(%Num(%i))
        右(1)
        If %Cnt-%i=0 Then
                Jump(,,%MyCol)
                下
                %Cnt=%Cnt+7
        End If
Next
%MyPage2=GetPage
%MyRow2=GetRow
%MyCol2=GetColumn
Jump(%MyPage,%MyRow,%MyCol)
RangeMode(1)
RangeStart
Jump(%MyPage2,%MyRow2,%MyCol2)
RangeEnd
フォント(.和文フォント名="ＭＳゴシック",.欧文フォント名=10)

しかし、InputCharacter（）を使って予めフォントを指定すれば、コードNo.1のように後からフォントを変更する必要はありませんでした。

!!コードNo.２

Range?()
%Str=GetString
%Nen=Mid(%Str(1) , 3 , 2)
%Tuki=Right(%Str(1),3)
If left(%Tuki,1) = "年" Or left(%Tuki,1) = " " Or left(%Tuki,1) = "　"Then
        %Tuki = Mid(%Tuki,2,1)
Else
        %Tuki = Left(%Tuki,2)
End If
%Nen = %Nen + 1988

%Pos=DayOfWeek( %Nen , %Tuki, 1 )
%Cnt=7-%Pos+1

下
行頭
%MyRow=GetRow
%MyCol=GetColumn
%MyPage=GetPage
Insert("日月火水木金土",1)
%Num={" 1"," 2"," 3"," 4"," 5"," 6"," 7"," 8"," 9",10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31}

!!閏年判定
%IsLeapYear=False
If %Nen Mod 4 =0 Then
        %IsLeapYear= True
End If
If %Nen Mod 100 =0 Then
        %IsLeapYear= False
End If
If %Nen Mod 400 =0 Then
        %IsLeapYear= True
End If

!!月末最終日
Select Case %Tuki
        Case 1,3,5,7,8,10,12
                %最終日        =31
        Case 4,6,9,11
                %最終日        =30
        Case 2
                If %IsLeapYear =True Then
                        %最終日        =29
                Else
                        %最終日        =28
                End If
End Select

Jump(,,(%Pos -1)* 3+1)

For %i = 1 to %最終日
　　　 InputCharacter(.和文フォント名="ＭＳゴシック",.欧文フォント名=10)
        Insert(%Num(%i))
        右(1)
        If %Cnt-%i=0 Then
                Jump(,,%MyCol)
                下
                %Cnt=%Cnt+7
        End If
Next

（2007/03/09　追記)

もどる