The task was to pepare a sheet for each month of a year (for a decade of years), where the working days at each column hold the duration for overtime job, and a place under for signature, for a number of employers. There are two zones, one for the first 15 days and another for the rest days (up to last day of month) excluding Saturday and Sunday. So I have to place some ranges and adjust the lines between then, the width of some columns, the merging of some cells, the bagkround color of some cells, the alignment (Horizontal and Vertical) of some cells, the wrapping text property of some cells. Fibally I have to place the range for cells for one page, and the header/footer, plus the adjustment for resizing the sheet to adjust the landscape a4 page.
M2000 used for preparing the final Excel.
The WorkBook as we see it at Excel:
First I make one module and make some runs until I found the proper final design, so I put it all in a module inside module (lets say that the non visible here module is A), changing Year=2026 to Read Year, so the statement OneYear 2026 make the specific workbook for 2026. Including this in a for next loop we can get all the books (about 2 minutes for each book on my PC at work).
The for This { } block used to delete any new variable we make there. The j variable get the type by ThisDate (a date type), so we don't want to use it as that type outside the block, so because j was first created at this block, at the exit of the block erased. So the j after this block is a double type.
Each time a module exit, all variables "Cleared", including those which are objects. The properties which we make using With statement have a hard link with the object which connected, so changing the object, reflect the changing to the property which we bound it. The release of all objects happen from the reverse order the way they created. Because Excel is a COM type object, the destroy of that object may happen after a while, and not exactly the time we set Nothing to Excel variable used to hold the object. When we call second time the OneYear an new Excel object created (independent from any other where still exist, but non connected to this code).
The ecxel application (the COM object) no swhowing GUI (but if need to open a msgbox, can do it). As last command we run excel to open the specific xlsx file (same as the way we do on other examples, at this blog).
Module OneYear {
Read Year
Month=1
Const xlVAlignBottom =-4107& //Bottom
Const xlVAlignCenter =-4108& //Center
Const xlVAlignDistributed =-4117& //Distributed
Const xlVAlignJustify =-4130& //Justify
Const xlVAlignTop =-4160& //Top
Const xlHAlignCenter =-4108& //Center
Const xlHAlignCenterAcrossSelection =7& // Center across selection
Const xlHAlignDistributed =-4117& //Distribute
Const xlHAlignFill =5& //Fill
Const xlHAlignGeneral =1& //Align according to data type
Const xlHAlignJustify =-4130& //Justify
Const xlHAlignLeft =-4131& //Left
Const xlHAlignRight =-4152 //Right
Const xlHairline =1& //Hairline (thinnest border)
Const xlMedium =-4138& //Medium
Const xlThick =4& //Thick (widest border)
Const xlThin =2& //Thin
Const xlDiagonalDown =5 'Border running from the upper-left corner to the lower-right of each cell in the range.
Const xlDiagonalUp =6 'Border running from the lower-left corner to the upper-right of each cell in the range.
Const xlEdgeBottom =9 'Border at the bottom of the range.
Const xlEdgeLeft =7 'Border at the left edge of the range.
Const xlEdgeRight =10 'Border at the right edge of the range.
Const xlEdgeTop =8 'Border at the top of the range.
Const xlInsideHorizontal =12 'Horizontal borders for all cells in the range except borders on the outside of the range.
Const xlInsideVertical =11 'Vertical borders for all the cells in the range except borders on the outside of the range.
// Const xlWBATChart=-4109& //Chart
// Const xlWBATExcel4IntlMacroSheet=4& //Excel version 4 macro
// Const xlWBATExcel4MacroSheet=3& //Excel version 4 international macro
Const xlWBATWorksheet =-4167& //Worksheet
boolean FalseB, first=True
mydir$=path$(5) // Documents folder
target$="βιβλιο υπερωριών "+Year+".xlsx"
// prepare c$() array (for 3 return C)
Declare withevents Excel "Excel.Application"
With Excel, "Workbooks" as WorkBooks
for Month=1 to 12
for this {
a=stack
stack a {
for i=65 to 65+25
data chr$(i)
next
for i=65 to 65+25
Data "A"+chr$(i)
next
}
push array$(a)
}
read C$()
dim c$(1 to len(c$()))
// prepare labels for days
dim a1$(), a2$()
date ThisDate="1/"+Month+"/"+Year
? ThisDate
k=ThisDate+30
while str$(thisDate, "MMMM")<> str$(k, "MMMM")
k--
end while
boolean once=true
double v=0, m=0
for this {
for j=ThisDate to k
v=val(str$(j,"w") )
m=val(str$(j, "d"))
if once then
if m>15 then once=false : a1$()=array$([])
end if
if v<>1 and v <>7 then
data ucase$(str$(j,"dddd - d"))
end if
next
a2$()=array$([])
}
If exist(mydir$+target$) Then
Try ok {
dos "del "+shortdir$(mydir$+target$);
}
If error or not ok Then break
End If
if first then
first=false
Method WorkBooks, "Add", xlWBATWorksheet
With Excel, "ActiveWorkbook" as ActiveWorkbook
With Excel, "ActiveSheet" as ActiveSheet
With ActiveWorkbook, "Sheets" set Sheets
else
Method Sheets, "Add", , ActiveSheet, 1, xlWBATWorksheet
end if
With ActiveSheet, "name", ucase$(locale$(55+Month))+" "+Year
Try {
With ActiveSheet, "Range" set Range0 ("A1:AH74")
With ActiveSheet, "Range" set Range1 ("A1:AH1")
With ActiveSheet, "Range" set Range2 ("A74:AH74")
With ActiveSheet, "Range" set Range3 ("A1:A74")
With ActiveSheet, "Range" set Range4 ("AH1:AH74")
Method Range1, "Merge"
Method Range2, "Merge"
Method Range1, "Select"
With Range1, "Interior" set Interior1
With Interior1, "Color", &HFFFF&
With Range2, "Interior" set Interior2
With Interior2, "Color", &HFFFF&
With Range3, "Interior" set Interior3
With Interior3, "Color", &HFFFF&
With Range4, "Interior" set Interior4
With Interior4, "Color", &HFFFF&
Rem {
With Range0, "Borders" set Borders (xlEdgeBottom)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range0, "Borders" set Borders (xlEdgeTop)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range0, "Borders" set Borders (xlEdgeLeft)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range0, "Borders" set Borders (xlEdgeRight)
With Borders, "LineStyle", 1, "Weight", xlMedium
}
With ActiveSheet, "Range" set Range00 ("B2:AG70")
With Range00, "HorizontalAlignment", xlHAlignCenter
With Range00, "Borders" set Borders (xlInsideHorizontal)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range00, "Borders" set Borders (xlInsideVertical)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range00, "Borders" set Borders (xlEdgeBottom)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range00, "Borders" set Borders (xlEdgeTop)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range00, "Borders" set Borders (xlEdgeLeft)
With Borders, "LineStyle", 1, "Weight", xlMedium
With Range00, "Borders" set Borders (xlEdgeRight)
With Borders, "LineStyle", 1, "Weight", xlMedium
With ActiveSheet, "Columns" set Column ("A")
With Column, "ColumnWidth", 1.71
With ActiveSheet, "Columns" set Column ("AH")
With Column, "ColumnWidth", 1.71
With ActiveSheet, "Rows" set Row0 (1)
With Row0, "RowHeight", 12.75
With ActiveSheet, "Rows" set Row0 (74)
With Row0, "RowHeight", 12.75
MakePrinterPage(ActiveSheet, "","A1:AH74", true)
With ActiveSheet, "Range" set Range0 ("B2:AG6")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignGeneral
With Range0, "Value" as ThisValue, "Value" as ThisValue$
ThisValue$={Οι υπογράφοντες το παρόν δηλώνουμε υπεύθυνα ότι:
1. Δεν λάβαμε υπερωριακή αποζημίωση από άλλη πηγή
2. Οι υπερωρίες πραγματοποιήθηκαν εκτός ωρών εργασίας και διενέργειας απογευματινών ελέγχων.
3. Κάθε είδους πρόσθετες αποδοχές ή απολαβές δεν είναι κατά μήνα ανώτερες από το σύνολο των αποδοχών της οργανικής μας θέσης σύμφωνα με το άρθρο 104, παρ. 2 του Συντάγματος, καθώς και
4. Οι πάσης φύσεως αποδοχές και πρόσθετες αμοιβές ή απολαβές ή σύνταξη, δεν υπερβαίνουν τις εκάστοτε αποδοχές του Γενικού Γραμματέα Υπουργείου, σύμφωνα με το άρθρο 28 του Ν. 4354/2015 (Α’ 176)}
With ActiveSheet, "Range" set Range0 ("A7:AH7")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignBottom
ThisValue$=" "+Year+" - "+ucase$(locale$(55+Month))+"- ΠΡΩΤΟ 15ΘΗΜΕΡΟ "
With ActiveSheet, "Range" set Range0 ("B1")
With Range0, "ColumnWidth", 4
With ActiveSheet, "Range" set Range0 ("B8:B10")
Method Range0, "merge"
ThisValue$="A/A"
With ActiveSheet, "Range" set Range0 ("C8:C10")
Method Range0, "merge"
With Range0, "ColumnWidth", 30
ThisValue$="ΕΠΩΝΥΜΟ - ΟΝΟΜΑ"
With ActiveSheet, "Range" set Range0 ("D8:D10")
Method Range0, "merge"
With Range0, "ColumnWidth", 12
ThisValue$="ΘΕΣΗ"
With ActiveSheet, "Range" set Range0 ("B10:D74")
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignCenter, "WrapText", true
With ActiveSheet, "Range" set Range0 ("E8:E38")
With Range0, "ColumnWidth", .5
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("E40:E70")
Method Range0, "merge"
i=8
c=0
for j=6 to 5+len(a1$())*2 step 2
With ActiveSheet, "Range" set Range0 (c$(j)+i+":"+c$(j+1)+i)
Method Range0, "merge"
ThisValue$=a1$(c)
c++
With ActiveSheet, "Range" set Range0 (c$(j)+(i+1)+":"+c$(j+1)+(i+1))
Method Range0, "merge"
ThisValue$="ΔΙΑΡΚΕΙΑ"
With ActiveSheet, "Range" set Range0 (c$(j)+(i+2))
ThisValue$="ΑΠΟ"
With ActiveSheet, "Range" set Range0 (c$(j+1)+(i+2))
ThisValue$="ΕΩΣ"
next j
i=40
c=0
for j=6 to 5+len(a2$())*2 step 2
With ActiveSheet, "Range" set Range0 (c$(j)+i+":"+c$(j+1)+i)
Method Range0, "merge"
ThisValue$=a2$(c)
c++
With ActiveSheet, "Range" set Range0 (c$(j)+(i+1)+":"+c$(j+1)+(i+1))
Method Range0, "merge"
ThisValue$="ΔΙΑΡΚΕΙΑ"
With ActiveSheet, "Range" set Range0 (c$(j)+(i+2))
ThisValue$="ΑΠΟ"
With ActiveSheet, "Range" set Range0 (c$(j+1)+(i+2))
ThisValue$="ΕΩΣ"
next j
c=1
for i=11 to 11+13*2 step 2
With ActiveSheet, "Range" set Range0 ("B"+i+":B"+(i+1))
Method Range0, "merge"
ThisValue=c
c++
With ActiveSheet, "Range" set Range0 ("C"+i+":C"+(i+1))
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("D"+i+":D"+(i+1))
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("AD"+i+":AE"+(i+1))
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignCenter
for j=6 to 5+len(a1$())*2 step 2
With ActiveSheet, "Range" set Range0 (c$(j)+(i+1)+":"+c$(j+1)+(i+1))
Method Range0, "merge"
next j
next
With ActiveSheet, "Range" set Range0 ("AD8:AE10")
Method Range0, "merge"
ThisValue$={ΥΠΕΡΩΡΙΕΣ
Α'
15ΘΗΜΕΡΟΥ}
With ActiveSheet, "Range" set Range0 ("AD40:AE42")
Method Range0, "merge"
ThisValue$={ΥΠΕΡΩΡΙΕΣ
B'
15ΘΗΜΕΡΟΥ}
With ActiveSheet, "Range" set Range0 ("AF40:AG42")
Method Range0, "merge"
ThisValue$={ΣΥΝΟΛΙΚΕΣ
ΥΠΕΡΩΡΙΕΣ
ΜΗΝΑ}
With ActiveSheet, "Range" set Range0 ("AF8:AG38")
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("A39:AH39")
Method Range0, "merge"
ThisValue$=" "+Year+" - "+ucase$(locale$(55+Month))+"- ΔΕΥΤΕΡΟ 15ΘΗΜΕΡΟ "
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignBottom
With ActiveSheet, "Range" set Range0 ("B40:B42")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignBottom
ThisValue$="A/A"
With ActiveSheet, "Range" set Range0 ("C40:C42")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignBottom
ThisValue$="ΕΠΩΝΥΜΟ - ΟΝΟΜΑ"
With ActiveSheet, "Range" set Range0 ("D40:D42")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignBottom
ThisValue$="ΘΕΣΗ"
c=1
for i=43 to 43+13*2 step 2
With ActiveSheet, "Range" set Range0 ("B"+i+":B"+(i+1))
Method Range0, "merge"
ThisValue=c
c++
With ActiveSheet, "Range" set Range0 ("C"+i+":C"+(i+1))
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("D"+i+":D"+(i+1))
Method Range0, "merge"
With ActiveSheet, "Range" set Range0 ("AD"+i+":AE"+(i+1))
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignCenter
With ActiveSheet, "Range" set Range0 ("AF"+i+":AG"+(i+1))
Method Range0, "merge"
ThisValue$="=AD"+i+"+AD"+(i-32)
With Range0, "HorizontalAlignment", xlHAlignCenter, "VerticalAlignment", xlVAlignCenter, "NumberFormat", "##0;;;"
for j=6 to 5+len(a2$())*2 step 2
With ActiveSheet, "Range" set Range0 (c$(j)+(i+1)+":"+c$(j+1)+(i+1))
Method Range0, "merge"
next j
next
// Q71
With ActiveSheet, "Range" set Range0 ("AA71:AC73")
Method Range0, "merge"
With Range0, "HorizontalAlignment", xlHAlignCenter
ThisValue$={Ο Προϊστάμενος της Δ/νσης
ΧΡΙΣΤΟΦΙΔΗΣ ΓΕΩΡΓΙΟΣ}
rem {
With Range0, "Value" as ThisValue, "Value" as ThisValue$
ThisValue=1000
With ActiveSheet, "Range" set Range0 ("A2")
With ActiveSheet, "Range" set Range0 ("A3")
ThisValue$="=A1" // is a formula
}
}
next
again:
Try ok {
Method ActiveWorkbook, "SaveAs", mydir$+target$, 51
}
If error or not ok Then If ask("File is open, close it and Try again")=1 Then Goto again
Method ActiveWorkbook, "Close", SaveChanges:=True
Method Excel, "Quit"
wait 1000
Declare Excel Nothing
Win "excel",quote$(mydir$+target$)
Print "Done"
Function CentimeterToPoints(x)
method Excel, "InchesToPoints", x*0.393700787 as ret
=ret
End Function
Sub MakePrinterPage(ThisSheet, t$, st$, check)
try ok {
with ThisSheet, "PageSetup" set PageSetup
with PageSetup, "Orientation", 2
Margins()
if check then with PageSetup, "PrintArea", st$
with PageSetup, "PrintTitleRows", "$1:$1"
with PageSetup,"Zoom" as myZoom, "FitToPagesWide" as PagesWide, "FitToPagesTall" as PagesTall
myZoom=FalseB
PagesWide=1
if check then
PagesTall=FalseB
else
PagesTall=1 'FalseB
end if
Margins()
}
if error or not ok then Print "??3??"+error$
End Sub
Sub Margins()
with PageSetup, "LeftMargin", @CentimeterToPoints(1.8) , "RightMargin",@CentimeterToPoints(1.8) , "TopMargin", @CentimeterToPoints(1.9)
with PageSetup, "BottomMargin", @CentimeterToPoints(1.7), "HeaderMargin", @CentimeterToPoints(1.3),"FooterMargin", @CentimeterToPoints(1.2)
with PageSetup,"CenterHeader", "&B&18&"+{"Arial Black"}+"&K00007DΒΙΒΛΙΟ"+chr$(13)+"&B&10&"+{"Arial Black"}+"ΥΠΕΡΩΡΙΑΚΗΣ ΑΠΑΣΧΟΛΗΣΗΣ ΤΑΚΤΙΚΩΝ && ΑΟΡΙΣΤΟΥ ΧΡΟΝΟΥ ΥΠΑΛΛΗΛΩΝ"
with PageSetup,"LeftHeader", "&B&12&"+{"Arial Black"}+"&K00007DΔ2 Δ/ΝΣΗ ΠΡΟΓΡΑΜΜΑΤΩΝ, ΜΕΘΟΔΩΝ ΔΙΔΑΣΚΑΛΙΑΣ && ΔΙΑΣΥΝΔΕΣΗΣ"
with PageSetup,"RightHeader", "&B&12&"+quote$("Arial Black")+"ΜΗΝΑΣ: "+ucase$(locale$(55+Month))+" "+Year
with PageSetup, "CenterFooter","&K000000Σελίδα &P από &N"
with PageSetup, "CenterHorizontally", true, "CenterVertically", true
End Sub
}
for i=2026 to 2026 '2040
OneYear i
next
