*xlsxファイルカレンダーaragowサンプル
*excel.exeを使う
*遅い
*印刷ができる
*動作は
*aragow→excelcli101.dll→excelcs101.dll→excel.exe
*です
*excelcli101.dll
*excelcs101.dll
*の2個のdllをprgのフォルダに置く
*エクセルがインストールされている
*************************************************************************************
extern cdecl cint opnexcel(cint) excelcli101.dll
*excel.exeを開く 0は非表示 1は表示
extern cdecl cint opnbook(cstring) excelcli101.dll
*opnbook('d:\temp\test.xlsx')
*d:\temp\test.xlsxファイルがあれば開くなければ空のファイルを開く
extern cdecl cint opnsheet(cstring) excelcli101.dll
*opnsheet('sheet1')
*sheet1シートがあれば開くなければ空のシートを開く
extern cdecl cstring rcell(cint,cint,cstring) excelcli101.dll
*rcell(y1,x1,space(100))
*セルy1,x1を読み込むspace(100)はバッファとして使う数値も文字も文字として読み込まれる
extern cdecl cstring rcellu(cint,cint,cstring) excelcli101.dll
*rcellu(y1,x1,space(100))
*utf-8
extern cdecl cint wcellval(cint,cint,cint) excelcli101.dll
*wcellval(y1,x1,753)
*セルy1,x1に数値を書き込む
extern cdecl cint wcellstr(cint,cint,cstring) excelcli101.dll
*wcellstr(y1,x1,'abc')
*セルy1,x1に文字を書き込む数字の場合は"'753"としないと数値として書き込まれる
extern cdecl cint wcellstru(cint,cint,cstring) excelcli101.dll
*wcellstru(y1,x1,'abc')
*utf-8
extern cdecl cint cellattr(cint,cint,cint,cint,cstring,cint,cint,cint,cint,cint,cint,cint,cint,cint) excelcli101.dll
*cellattr(y1,x1,0,0,'ＭＳ Ｐ明朝',12,255,0,0,255,255,255,0,0)
*セルy1,x1,セルの高さh0デフォルト,セルの幅w0デフォルト,フォント名""デフォルト,フォントサイズsize0デフォルト,
*文字の色r,g,b,-1デフォルト,セルの色r,g,b,-1デフォルト,縦位置0デフォルト1上2中央3下,横位置0デフォルト1左2中央3右
extern cdecl cint cellmrg(cint,cint,cint,cint) excelcli101.dll
*cellmrg(y1,x1,y2,x2)
*セルy1,x1からセルy2,x2までをマージする
extern cdecl cint setprint(cint,cint,cint,cint,cint,cint,cint,cint,cint,cint,cint,cint) excelcli101.dll
*setprint(y1,x1,y2,x2,9,1,15,15,20,20,0,0)
*セルy1,x1からセルy2,x2までを印刷する用紙サイズ0デフォルト8:a3/9:a4/12:b5/13:b4,用紙方向0デフォルト1縦2横,
*topマージンmm,bottomマージンmm,leftマージンmm,rightマージンmm,headerマージンmm,footerマージンmm
extern cdecl cint printout(cint,cint,cint) excelcli101.dll
*開始ページ,終了ページ,部数
extern cdecl cint savebook(cstring) excelcli101.dll
*savebook('d:\temp\test.xlsx')
*上書き保存
extern cdecl cint clssheet(cvoid) excelcli101.dll
*シートを閉じる
extern cdecl cint clsbook(cvoid) excelcli101.dll
*xlsxファイルを閉じる
extern cdecl cint clsexcel(cvoid) excelcli101.dll
*excel.exeを閉じる
*************************************************************************************
set talk off
set language to american
set century on
declare flag[31]
declare syuku[4]
declare array01[83]
store dtoc(date()) to today01
store val(subs(today01,1,4))-1947 to init01
define panel panel01 from 0.0, 0.0 to 320.0, 380.0
set font font01 to of 'ＭＳ 明朝', 20
define text text01 of panel01 at 40.0,80.0 prompt 'カレンダー印刷' color 0,255,0 font font01
store 1948 to c
do while c<=2030
	c0=c-1947
	array01[c0] = (func01(str(c,4)))
	store c+1 to c
endd
define combobox conbo01 of panel01 from 100.0,80.0 to 210.0,170.0 drop prompt array array01 init init01
define text text02 of panel01 at 103.0,170.0 prompt '年'
define pushbutton button01 of panel01 at 160.0,80.0 prompt '    印刷    '
define pushbutton button02 of panel01 at 160.0,200.0 prompt '    終了    '
on selection panel panel01 do select01
activate panel panel01 modal
release panel panel01
return
proc select01
	if panel()='BUTTON01'
		do proc01
	elseif panel()='BUTTON02'
		deactivate panel panel01
	endif
return
procedure proc01
	store val(func02(getcombobox('panel01','conbo01'))) to year00
	if opnexcel(1)<>0
		? 'エクセルを起動できません'
		return
	endi
	if opnbook('d:\temp\calendar.xlsx')<>0
		? 'ブックに書き込みできません'
		clsexcel()
		return
	endi
	if opnsheet('カレンダー')<>0
		? 'シートを開けません'
		clsbook()
		clsexcel()
		return
	endi
	store str(year00,4)+'年' to head00
	do case
		case year00<=1988
			store head00+'（昭和'+str(year00-1925,2)+'年）' to head00
		case year00=1989
			store head00+'（平成元年）' to head00
		case year00>=1990 .and. year00<=2018
			store head00+'（平成'+str(year00-1988,2)+'年）' to head00
		case year00=2019
			store head00+'（令和元年）' to head00
		otherwise
			store head00+'（令和'+str(year00-2018,2)+'年）' to head00
	endc
	define text text03 of panel01 at 220.0,80.0 prompt head00 color 0,0,0 font font01
cellmrg(1, 1, 1, 23)
cellattr(1,1, 24, 3, 'HG正楷書体-PRO', 20, 0, 176, 80, -1, 255, 255, 0, 2)
wcellstr(1,1,head00+'　　カレンダー')
	store 1 to month00
	do while month00<=12
			do case
		case month00<=3
				store month00*8-7 to x0
			store 4 to y0
		case month00<=6
				store (month00-3)*8-7 to x0
			store 16 to y0
		case month00<=9
			store (month00-6)*8-7 to x0
			store 28 to y0
		case month00<=12
			store (month00-9)*8-7 to x0
			store 40 to y0
		endc	    
		do proc02
		store x0 to x
		store y0 to y
cellmrg(y, x, y, x+6)
cellattr(y,x, 15, 3, 'HG正楷書体-PRO', 14, 0, 176, 80, -1, 0, 0, 0, 2)
wcellstr(y,x,"'"+str(year00,4)+'年'+str(month00,2)+'月')
		store 1 to c
		do while c<=4
cellmrg(y+c+7, x, y+c+7, x+7)
cellattr(y+c+7,x, 12, 3, 'ＭＳ 明朝', 10, 255, 0, 0, -1, 0, 0, 0, 1)
wcellstr(y+c+7,x,'')
			store c+1 to c
		endd
		store 1 to c
		do while c<=4
wcellstr(y+c+7,x,syuku[c])
			store c+1 to c
		endd
		store y0+1 to y
		store 1 to c
		do while c<=7
			do case
				case mod(x,8)=1
cellattr(y,x, 15, 3, 'HG正楷書体-PRO', 14, 255, 0, 0, -1, 0, 0, 0, 2)
				case mod(x,8)=7
cellattr(y,x, 15, 3, 'HG正楷書体-PRO', 14, 0, 0, 255, -1, 0, 0, 0, 2)
				othe
cellattr(y,x, 15, 3, 'HG正楷書体-PRO', 14, 0, 0, 0, -1, 0, 0, 0, 2)
			endc
			do case
				case c=1
wcellstr(y,x,'日')
				case c=2
wcellstr(y,x,'月')
				case c=3
wcellstr(y,x,'火')
				case c=4
wcellstr(y,x,'水')
				case c=5
wcellstr(y,x,'木')
				case c=6
wcellstr(y,x,'金')
				case c=7
wcellstr(y,x,'土')
			endc
			store x+1 to x
			store c+1 to c
		enddo
cellattr(y,x, 15, 3, 'HG正楷書体-PRO', 14, 0, 0, 255, -1, 0, 0, 0, 2)
		do case
			case mod(year00,4)=0 .and. month00=2
				store 29 to d
			case mod(year00,4)<>0 .and. month00=2
				store 28 to d
			case month00=1 .or. month00=3 .or. month00=5 .or. month00=7 .or. month00=8 .or. month00=10 .or.month00=12
				store 31 to d
			case month00=4 .or. month00=6 .or. month00=9 .or. month00=11
				store 30 to d
		endc
		store dow(ctod(str(year00,4)+'/'+str(month00,2)+'/01')) to week00
		store x0 to x
		store x0-1+week00 to xd
		store y0+2 to y
		do while x<xd
wcellstr(y,x,'')
			if mod(x+1,8)=0
				store x0-1 to x
				store y+1 to y
			endif
			store x+1 to x
		enddo
		store x0-1+week00 to x
		store y0+2 to y
		store 1 to c
		do while c<=d
			do case
				case mod(x,8)=1 .or. flag[c]=1
cellattr(y,x, 14, 3, 'Century', 13, 255, 0, 0, -1, 0, 0, 0, 2)
				case mod(x,8)=7
cellattr(y,x, 14, 3, 'Century', 13, 0, 0, 255, -1, 0, 0, 0, 2)
				othe
cellattr(y,x, 14, 3, 'Century', 13, 0, 0, 0, -1, 0, 0, 0, 2)
			endc
wcellval(y,x,c)
			if mod(x+1,8)=0
				store x0-1 to x
				store y+1 to y
			endif
			store x+1 to x
			store c+1 to c
		enddo
		do while y<=(y0+7)
wcellstr(y,x,'')
			if mod(x+1,8)=0
				store x0-1 to x
				store y+1 to y
			endif
			store x+1 to x
		enddo
		store month00+1 to month00
	endd
setprint(1,1,51,23,9,1,26,10,20,10,0,0)
*印刷
*printout( 1, 1, 1)
? savebook('d:\temp\calendar.xlsx')
clssheet()
clsbook()
clsexcel()
return
procedure proc02
	store 1 to c
	do while c<=4
		store '' to syuku[c]
		store c+1 to c
	endd
	store 1 to c
	do while c<=31
		store 0 to flag[c]
		store c+1 to c
	endd
	store dow(ctod(str(year00,4)+'/'+str(month00,2)+'/01')) to week01
	store year00 to temp01,x
	store month00 to temp02
	do case
		case temp02=1
		if week01=1 .and. temp01>=1974
			store 1 to flag[2]
		else
			store 1 to flag[1]
		endi
		syuku[1]=' 1 元旦'
		if temp01<=1999
			if week01=1 .and. temp01>=1974
				store 1 to flag[16]
			else
				store 1 to flag[15]
			endi
			syuku[2]='15 成人の日'
		else	    
			do case
				case week01=1
					store 1 to flag[9]
					syuku[2]=' 9 成人の日'
				case week01=2
					store 1 to flag[8]
					syuku[2]=' 8 成人の日'
				case week01=3
					store 1 to flag[14]
					syuku[2]='14 成人の日'
				case week01=4
					store 1 to flag[13]
					syuku[2]='13 成人の日'
				case week01=5
					store 1 to flag[12]
					syuku[2]='12 成人の日'
				case week01=6
					store 1 to flag[11]
					syuku[2]='11 成人の日'
				case week01=7
					store 1 to flag[10]
					syuku[2]='10 成人の日'
			endc
		endi
		case temp02=2
			if week01=5 .and. temp01>=1974
				store 1 to flag[12]
			else
				store 1 to flag[11]
			endi
			syuku[1]='11 建国記念の日'
			if temp01=1989
				store 1 to flag[24]
				syuku[2]='24 大喪の礼'
			endi
			if temp01>=2019
				if week01=7 .and. temp01>=1974
					store 1 to flag[24]
				else
					store 1 to flag[23]
				endi
				syuku[2]='23 天皇誕生日'
			endi
		case temp02=3
			if func05(x)=21
				if week01=2 .and. temp01>=1973
					store 1 to flag[22]
				else
					store 1 to flag[21]
				endi
				syuku[1]='21 春分の日'
			else
				if week01=3 .and. temp01>=1973
					store 1 to flag[21]
				else
					store 1 to flag[20]
				endi
				syuku[1]='20 春分の日'
			endi
		case temp02=4
			if temp01=1959
				store 1 to flag[10]
				syuku[1]='10 結婚の儀'
				store 1 to flag[29]
				syuku[2]='29 天皇誕生日'
			else
				if week01=1 .and. temp01>=1973
					store 1 to flag[30]
				else
					store 1 to flag[29]
				endi
				do case
					case temp01<=1988
						syuku[1]='29 天皇誕生日'
					case temp01<=2006
						syuku[1]='29 みどりの日'
					otherwise
						syuku[1]='29 昭和の日'
				endcase
			endi
		case temp02=5
			if week01=6 .and. temp01>=1973
				store 1 to flag[4]
			else
				store 1 to flag[3]
			endi
			syuku[1]=' 3 憲法記念日'
			if temp01>=1985
				store 1 to flag[4]
			endi
			if week01=4 .and. temp01>=1973
				store 1 to flag[6]
			else
				store 1 to flag[5]
			endi
			if temp01>=2007
				syuku[2]=' 4 みどりの日'
				syuku[3]=' 5 こどもの日'
			else
				syuku[2]=' 5 こどもの日'
			endi
			if temp01>=2007
				if week01=4 .or. week01=5 .or. week01=6
					store 1 to flag[6]
				endi
			endif
		case temp02=6
			if temp01=1993
				store 1 to flag[9]
				syuku[1]=' 9 結婚の儀'
			endi
		case temp02=7
			if temp01>=1996 .and. temp01<=2002
				if week01=3 .and. temp01>=1973
					store 1 to flag[21]
				else
					store 1 to flag[20]
				endi
				syuku[1]='20 海の日'
			endif
			if temp01=2020 .or. temp01=2021
				if temp01=2020
					store 1 to flag[23]
					store 1 to flag[24]
					syuku[1]='23 海の日'
					syuku[2]='24 スポーツの日'
				else
					store 1 to flag[22]
					store 1 to flag[23]
					syuku[1]='22 海の日'
					syuku[2]='23 スポーツの日'
				endif
			else
				do case
					case week01=1
						store 1 to flag[16]
						syuku[1]='16 海の日'
					case week01=2
						store 1 to flag[15]
						syuku[1]='15 海の日'
					case week01=3
						store 1 to flag[21]
						syuku[1]='21 海の日'
					case week01=4
						store 1 to flag[20]
						syuku[1]='20 海の日'
					case week01=5
						store 1 to flag[19]
						syuku[1]='19 海の日'
					case week01=6
						store 1 to flag[18]
						syuku[1]='18 海の日'
					case week01=7
						store 1 to flag[17]
						syuku[1]='17 海の日'
				endc
			endif
		case temp02=8
			if temp01=2020 .or. temp01=2021
				if temp01=2020
					store 1 to flag[10]
					syuku[1]='10 山の日'
				else
					store 1 to flag[8]
					store 1 to flag[9]
					syuku[1]=' 8 山の日'
				endif
			else
				if temp01>=2016
					if week01=5
						store 1 to flag[12]
					else
						store 1 to flag[11]
					endi
					syuku[1]='11 山の日'
				endif
			endif
		case temp02=9
			if temp01>=2003
				do case
					case week01=1
						store 1 to flag[16]
						syuku[1]='16 敬老の日'
					case week01=2
						store 1 to flag[15]
						syuku[1]='15 敬老の日'
					case week01=3
						store 1 to flag[21]
						syuku[1]='21 敬老の日'
					case week01=4
						store 1 to flag[20]
						syuku[1]='20 敬老の日'
					case week01=5
						store 1 to flag[19]
						syuku[1]='19 敬老の日'
					case week01=6
						store 1 to flag[18]
						syuku[1]='18 敬老の日'
					case week01=7
						store 1 to flag[17]
						syuku[1]='17 敬老の日'
				endc
			else
				if temp01>=1966
					if week01=6 .and. temp01>=1973
						store 1 to flag[16]
					else
						store 1 to flag[15]
					endi
					syuku[1]='15 敬老の日'
				endi
			endif
			do case
				case func06(x)=24
					if week01=6 .and. temp01>=1973
						store 1 to flag[25]
					else
						store 1 to flag[24]
					endi
					syuku[2]='24 秋分の日'
				case func06(x)=23
					if week01=7 .and. temp01>=1973
						store 1 to flag[24]
					else
						store 1 to flag[23]
					endi
					syuku[2]='23 秋分の日'
					if temp01=2009 .or. temp01=2015 .or. temp01=2026
						store 1 to flag[22]
						syuku[2]='22 国民の休日'
						syuku[3]='23 秋分の日'
					endif
				case func06(x)=22
					if week01=1 .and. temp01>=1973
						store 1 to flag[23]
					else
						store 1 to flag[22]
					endi
					syuku[2]='22 秋分の日'
			endc
		case temp02=10
			if temp01>=1966 .and. temp01<=1999
				if week01=6 .and. temp01>=1973
					store 1 to flag[11]
				else
					store 1 to flag[10]
				endi
				syuku[1]='10 体育の日'
			endif
			if temp01>=2000 .and. temp01<=2019
				do case
					case week01=1
						store 1 to flag[9]
						syuku[1]=' 9 体育の日'
					case week01=2
						store 1 to flag[8]
						syuku[1]=' 8 体育の日'
					case week01=3
						store 1 to flag[14]
						syuku[1]='14 体育の日'
					case week01=4
						store 1 to flag[13]
						syuku[1]='13 体育の日'
					case week01=5
						store 1 to flag[12]
						syuku[1]='12 体育の日'
					case week01=6
						store 1 to flag[11]
						syuku[1]='11 体育の日'
					case week01=7
						store 1 to flag[10]
						syuku[1]='10 体育の日'
				endc
			endif
			if temp01>=2022
				do case
					case week01=1
						store 1 to flag[9]
						syuku[1]=' 9 スポーツの日'
					case week01=2
						store 1 to flag[8]
						syuku[1]=' 8 スポーツの日'
					case week01=3
						store 1 to flag[14]
						syuku[1]='14 スポーツの日'
					case week01=4
						store 1 to flag[13]
						syuku[1]='13 スポーツの日'
					case week01=5
						store 1 to flag[12]
						syuku[1]='12 スポーツの日'
					case week01=6
						store 1 to flag[11]
						syuku[1]='11 スポーツの日'
					case week01=7
						store 1 to flag[10]
						syuku[1]='10 スポーツの日'
				endc
			endif
		case temp02=11
			if week01=6 .and. temp01>=1974
				store 1 to flag[4]
			else
				store 1 to flag[3]
			endi
			syuku[1]=' 3 文化の日'
			if temp01=1990
				store 1 to flag[12]
				syuku[2]='12 即位礼正殿の儀'
				syuku[3]='23 勤労感謝の日'
			else
				syuku[2]='23 勤労感謝の日'
			endi				    
			if week01=7 .and. temp01>=1974
				store 1 to flag[24]
			else
				store 1 to flag[23]
			endi
		case temp02=12
			if temp01>=1989 .and. temp01<=2019
				if week01=7 .and. temp01>=1974
					store 1 to flag[24]
				else
					store 1 to flag[23]
				endi
				syuku[1]='23 天皇誕生日'
			endi
	endc
return
function func01
parameters temp01
	store '' to temp02
	store 1 to k
	do while k<=4
		do case
			case substr(temp01,k,1)='0'
				store temp02+'０' to temp02
			case substr(temp01,k,1)='1'
				store temp02+'１' to temp02
			case substr(temp01,k,1)='2'
				store temp02+'２' to temp02
			case substr(temp01,k,1)='3'
				store temp02+'３' to temp02
			case substr(temp01,k,1)='4'
				store temp02+'４' to temp02
			case substr(temp01,k,1)='5'
				store temp02+'５' to temp02
			case substr(temp01,k,1)='6'
				store temp02+'６' to temp02
			case substr(temp01,k,1)='7'
				store temp02+'７' to temp02
			case substr(temp01,k,1)='8'
				store temp02+'８' to temp02
			case substr(temp01,k,1)='9'
				store temp02+'９' to temp02
		endc
		store k+1 to k
	endd
return temp02
function func02
parameters temp01
	store '' to temp02
	store 1 to k
	do while k<=8
		do case
			case substr(temp01,k,2)='０'
				store temp02+'0' to temp02
			case substr(temp01,k,2)='１'
				store temp02+'1' to temp02
			case substr(temp01,k,2)='２'
				store temp02+'2' to temp02
			case substr(temp01,k,2)='３'
				store temp02+'3' to temp02
			case substr(temp01,k,2)='４'
				store temp02+'4' to temp02
			case substr(temp01,k,2)='５'
				store temp02+'5' to temp02
			case substr(temp01,k,2)='６'
				store temp02+'6' to temp02
			case substr(temp01,k,2)='７'
				store temp02+'7' to temp02
			case substr(temp01,k,2)='８'
				store temp02+'8' to temp02
			case substr(temp01,k,2)='９'
				store temp02+'9' to temp02
		endc
		store k+2 to k
	endd
return temp02
function func05
parameters temp01
	do case
		case temp01=1960 .or. temp01=1964 .or. temp01=1968 .or.temp01=1972
			store 20 to temp02
		case temp01=1976 .or. temp01=1980 .or. temp01=1984 .or.temp01=1988
			store 20 to temp02
		case temp01=1992 .or. temp01=1993 .or. temp01=1996 .or.temp01=1997
			store 20 to temp02
		case temp01=2000 .or. temp01=2001 .or. temp01=2004 .or.temp01=2005
			store 20 to temp02
		case temp01=2008 .or. temp01=2009 .or. temp01=2012 .or.temp01=2013
			store 20 to temp02
		case temp01=2016 .or. temp01=2017 .or. temp01=2020 .or.temp01=2021
			store 20 to temp02
		case temp01=2024 .or. temp01=2025 .or. temp01=2026
			store 20 to temp02
		case temp01=2028 .or. temp01=2029 .or. temp01=2030
			store 20 to temp02
		othe
			store 21 to temp02
	endc
return temp02
function func06
parameters temp01
	do case
		case temp01=1951 .or. temp01=1955 .or. temp01=1959 .or.temp01=1963
			store 24 to temp02
		case temp01=1967 .or. temp01=1971 .or. temp01=1975 .or.temp01=1979
			store 24 to temp02
		case temp01=2012 .or. temp01=2016 .or. temp01=2020 .or.temp01=2024
			store 22 to temp02
		case temp01=2028
			store 22 to temp02
		othe
			store 23 to temp02
	endc
return temp02