Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
FET (timetabling software) ed esportazione in Microsoft Excel
472 views
Skip to first unread message
Pg
Aug 12, 2013, 4:15:50 AM8/12/13
to
Ciao,
spero qualcuno possa aiutarmi.
premetto che sono ignorante in materia...
Ho compilato sul mio iMac questo software (FET, timetabling software):
https://sites.google.com/site/ilpassodellupo/home
per fare l'orario scolastico del mio Liceo.
Tutto ok, però quando ho ultimato il lavoro mi sono accorto che non è agevole la stampa finale dell'orario (L'orario prodotto è registrato per mezzo di più file in formato xml e html).
Un utente ha ideato uno script, un particolare foglio di calcolo contenente una macro capace di importare in Excel l'orario generato da FET dicendo che funziona solo su Excel e non con gli altri software perché è stato costruito con visualbasic e non con java.
E' una breve elaborazione, produce una serie di fogli contenenti tutte le informazioni necessarie a distribuire e stampare l'orario con la massima libertà.
E' utile anche per fare piccoli ritocchi senza aprire il software principale (che è mooolto laborioso)...
Ho scaricato lo script : Fet_import_in_excel_UTF8.zip dal forum
http://lalescu.ro/liviu/fet/forum/index.php?action=dlattach;topic=504.0;attach=149
e lo aperto con Microsoft Excel 2011 v.14.3.6
mi chiede se attivare la Macro
Ok
mi risulta sempre :
Errore di runtime "1004" :
Metodo "GetOpenFilename" dell'oggetto "_Application" non riuscito.
con i pulsanti :
Continua (non attivo)
Fine
Debug
?
Se seleziono "Debug" mi compaiono 4 finestre :
Progetto
Proprietà
Fet_import_in_excel_UTF8.XLS - Modulo2 (codice)
Fet_import_in_excel_UTF8.XLS - Modulo3 (codice)
evidenziandomi in giallo :
FN = Application.GetOpenFilename(FileFilter:="fet File (*.fet), *.fet", Title:="Seleziona il file <.fet> che vuoi elaborare DALLA CARTELLA fet-results/timetables")
sul FORUM di FET dicono di abilitare le macro: menù Strumenti/ Macro/ Protezione ... seleziona il livello medio (non di più, altrimenti non funzionerà).
riferito probabilmente alla versione di Windows perchè io ho cercato ma non sono riuscito a trovare il corrispondente su excel in mac osx....
ho caricato anche excel (per windows XP) sul mio VMware fusion ma niente, stesso problema
non so più che fare
qualche buon'anima non in vacanza mi può dare qualche suggerimento?
grazie mille
Pg
su modulo 2 :
Sub trovadati()
t_res = ""
trovai = InStr(t_a, t_i)
trovaf = InStr(t_a, t_f)
If trovai = 0 Then Exit Sub
t_res = Mid(t_a, trovai + Len(t_i), trovaf - trovai - Len(t_f) + 1)
Mid(t_a, trovai, 3) = " "
Mid(t_a, trovaf, 3) = " "
'Stop
End Sub
Sub Macroq(prange)
'
' Macroq Macro
' Macro registrata il 10/08/2009 da pc
'
' Scelta rapida da tastiera: CTRL+s
'
Range(prange).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sub perclassim1(rang)
'
'
Range(rang).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub perclassim2(rang)
'
Range(rang).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub colorav(prange)
'
Range(prange).Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End Sub
Sub perclassim()
'
' Macro1 Macro
' Macro registrata il 16/08/2009 da pc
'
' Scelta rapida da tastiera: CTRL+r
'
Range("C45:H45").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("C51:H64").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C54:H56").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C57:H59").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C60:H62").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sub unisce(ranges)
'
' Macro2 Macro
' Macro registrata il 17/08/2009 da PC
'
' Scelta rapida da tastiera: CTRL+t
'
Range(ranges).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End Sub
Sub colorar(prange)
'
Range(prange).Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
End Sub
su Modulo 3 :
Public t_a, t_i, t_f, t_res, trovaf, FN, fint, fout, FNI
Private Const CP_UTF8 = 65001
Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Function sUTF8ToUni(bySrc() As Byte) As String
' Converts a UTF-8 byte array to a Unicode string
Dim lBytes As Long, lNC As Long, lRet As Long
lBytes = UBound(bySrc) - LBound(bySrc) + 1
lNC = lBytes
sUTF8ToUni = String$(lNC, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
sUTF8ToUni = Left$(sUTF8ToUni, lRet)
End Function
Public Sub ConvertUTF8File()
Dim iFile As Integer, bData() As Byte, sData As String, lSize As Long
' Get the incoming data size
lSize = FileLen(FNI)
If lSize > 0 Then
ReDim bData(0 To lSize - 1)
' Read the existing UTF-8 file
iFile = FreeFile()
Open FNI For Binary As #iFile
Get #iFile, , bData
Close #iFile
' Convert all the data to Unicode (all VB Strings are Unicode)
sData = sUTF8ToUni(bData)
Else
sData = ""
End If
fout = sData
' Now write it all out to the ANSI file
' iFile = FreeFile()
' Open sANSIFile For Output As #iFile
' Print #iFile, sData
' Close iFile
End Sub
Sub legge()
Dim docenti(120)
Dim maxhdocenti(120) As Integer
Dim attivita(1500, 7) As String
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata 7 malposta
Dim attivital(1500, 9) As Integer
' in '0' lontananza attivita lontana di '1' e in '2' attivita lontana di '3'
Dim miste(200, 10, 7) As String
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata 7=INDICE IN attivita
Dim trdoc(20)
Dim trcla(20)
Dim giorni(15)
Dim ore(12)
Dim classi(200)
Dim cattedre(100, 20, 1)
Dim cattedreh(100, 20) As Integer
Dim serv(1500) As Integer
FN = Application.GetOpenFilename(FileFilter:="fet File (*.fet), *.fet", Title:="Seleziona il file <.fet> che vuoi elaborare DALLA CARTELLA fet-results/timetables")
'
If FN = False Then
MsgBox "programma terminato, non hai scelto il file"
Exit Sub
End If
'
'legge dati scuola
ActiveWorkbook.Sheets("partenza").Activate
Range("c3").Select
scuola = ActiveCell.Offset(0, 0).Value
Range("c6").Select
anno = ActiveCell.Offset(0, 0).Value
Range("c8").Select
If ActiveCell.Offset(0, 0).Value = "1" Then GUTF = 1 Else GUTF = 0
Range("c9").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gliberi = 1 Else gliberi = 0
Range("c10").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gtroppe = 1 Else gtroppe = 0
Range("c11").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gcons = 1 Else gcons = 0
If GUTF = 0 Then
Open FN For Input As #1
Do Until EOF(1)
Line Input #1, Riga
aa$ = Riga
aa1$ = aa$
Loop
Close #1
Else
FNI = FN
ConvertUTF8File
aa$ = fout
aa1$ = fout
End If
sdocente = "<Teacher>"
fdocente = "</Teacher>"
ldocente = Len(sdocente)
sclasse = "<Students name="
fclasse = "</Students"
lclasse = Len(sclasse)
sgiorno = "Day name="
fgiorno = "/Day"
lgiorno = Len(sgiorno)
sore = "<Hour name="
fore = "</Hour"
lore = Len(sore)
saula = "<Room name="
faula = "</Room"
laula = Len(saula)
'
'--- docenti
ndoc = 0
t_a = aa$: t_i = "<Teachers_List>": t_f = "</Teachers_List>"
trovadati
perdoc = t_res
trovadoc = InStr(perdoc, "<Name>")
indd = 0
Do While trovadoc > 0
t_a = perdoc: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
docenti(indd) = t_res
perdoc = t_a
trovadoc = InStr(perdoc, "<Name>")
If indd > 99 Then Stop
Loop
ndoc = indd
'---
'----- classi
ncla = 0
t_a = aa$: t_i = "<Students_List>": t_f = "</Students_List>"
trovadati
percla = t_res
trovacla = InStr(percla, "<Name>")
indd = 0
Do While trovacla > 0
t_a = percla: t_i = "<Name>": t_f = "</Name>"
trovadati
If Len(t_res) > 1 Then
indd = indd + 1
classi(indd) = t_res
End If
percla = t_a
trovacla = InStr(percla, "<Name>")
If indd > 199 Then Stop
Loop
ncla = indd
'---
'------ ore e giorni
ngg = 0: nhh = 0
t_a = aa$: t_i = "<Hours_List>": t_f = "</Hours_List>"
trovadati
perore = t_res
trovaore = InStr(perore, "<Name>")
indd = 0
Do While trovaore > 0
t_a = perore: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
ore(indd) = t_res
perore = t_a
trovaore = InStr(perore, "<Name>")
If indd > 50 Then Stop
Loop
nhh = indd
t_a = aa$: t_i = "<Days_List>": t_f = "</Days_List>"
trovadati
perg = t_res
trovag = InStr(perg, "<Name>")
indd = 0
Do While trovag > 0
t_a = perg: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
giorni(indd) = t_res
perg = t_a
trovag = InStr(perg, "<Name>")
If indd > 50 Then Stop
Loop
ngg = indd
'---
'---- lezioni
conta = 0
ctmiste = 0
trovaact = InStr(aa$, "<Activity>")
Do While trovaact > 0
t_a = aa$: t_i = "<Activity>": t_f = "</Activity>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Id>": t_f = "</Id>"
trovadati
t_ind = t_res
t_a = peract: t_i = "<Subject>": t_f = "</Subject>"
trovadati
materia = t_res
t_a = peract: t_i = "<Duration>": t_f = "</Duration>"
trovadati
durata = t_res
' possibili piu docenti
trovadoc = InStr(peract, "<Teacher>")
indd = 0
Do While trovadoc > 0
t_a = peract: t_i = "<Teacher>": t_f = "</Teacher>"
trovadati
indd = indd + 1
trdoc(indd) = t_res
peract = t_a
trovadoc = InStr(peract, "<Teacher>")
Loop
' possibili piu classi
trovacla = InStr(peract, "<Students>")
indc = 0
Do While trovacla > 0
t_a = peract: t_i = "<Students>": t_f = "</Students>"
trovadati
indc = indc + 1
trcla(indc) = t_res
peract = t_a
trovacla = InStr(peract, "<Students>")
Loop
'
fatto = 0
If (indd = 1) And (indc = 1) Then
attivita(t_ind, 0) = trdoc(1)
attivita(t_ind, 1) = trcla(1)
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
fatto = 1
End If
If (indd > 1) And (indc = indd) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(ii)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If (indc > indd) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indc
miste(ctmiste, ii, 0) = trdoc(1)
miste(ctmiste, ii, 1) = trcla(ii)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If (indd > indc) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(1)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If fatto = 0 Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(1)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
conta = conta + 1
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<Activity>")
If conta > 1999 Then Stop
Loop
'---------------
'------------------------------------------------------------ errore di max ore
For ji = 1 To ndoc
maxhdocenti(ji) = 100
Next
'------------------
aa$ = aa1$ 'ricostruisce quanto letto nel file e tagliato routine precedente
'------------------
trovaact = InStr(aa$, "<ConstraintTeachersMaxHoursDaily>")
If trovaact > 0 Then
t_a = aa$: t_i = "<ConstraintTeachersMaxHoursDaily>": t_f = "</ConstraintTeachersMaxHoursDaily>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Maximum_Hours_Daily>": t_f = "</Maximum_Hours_Daily>"
trovadati
t_ind = t_res
t_maxd = t_res
For ji = 1 To ndoc
If maxhdocenti(ji) = 100 Then maxhdocenti(ji) = t_maxd
Next
End If
trovaact = InStr(aa$, "<ConstraintTeacherMaxHoursDaily>")
Do While trovaact > 0
t_a = aa$: t_i = "<ConstraintTeacherMaxHoursDaily>": t_f = "</ConstraintTeacherMaxHoursDaily>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Teacher_Name>": t_f = "</Teacher_Name>"
trovadati
t_ind = t_res
t_nomed = t_res
t_a = peract: t_i = "<Maximum_Hours_Daily>": t_f = "</Maximum_Hours_Daily>"
trovadati
t_ind = t_res
t_maxd = t_res
If t_nomed = "" Then
Else
For ji = 1 To ndoc
If t_nomed = docenti(ji) Then maxhdocenti(ji) = t_maxd: ji = ndoc + 1: contamh = 1 + contamh
Next
End If
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<ConstraintTeacherMaxHoursDaily>")
If conta > 1999 Then Stop
Loop
'------------------------------------------------------------ errore di ore vicine
'------------------
aa$ = aa1$ 'ricostruisce quanto letto nel file e tagliato routine precedente
'------------------
For ji = 1 To 1500
For j2 = 0 To 5
attivital(ji, j2) = 0
Next
Next
pros = 0
trovaact = InStr(aa$, "<ConstraintMinDaysBetweenActivities>")
luup = 0
Do While trovaact > 0
luup = luup + 1
t_a = aa$: t_i = "<ConstraintMinDaysBetweenActivities>": t_f = "</ConstraintMinDaysBetweenActivities>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Number_of_Activities>": t_f = "</Number_of_Activities>"
trovadati
t_ind = t_res
t_numat = t_res
t_a = peract: t_i = "<MinDays>": t_f = "</MinDays>"
trovadati
t_numd = t_res
' trova piu attivita
trovaatt = InStr(peract, "<Activity_Id>")
indd = 0
Do While trovaatt > 0
t_a = peract: t_i = "<Activity_Id>": t_f = "</Activity_Id>"
trovadati
indd = indd + 1
trdoc(indd) = t_res 'vettore non piu in uso
peract = t_a
trovaatt = InStr(peract, "<Activity_Id>")
Loop
If indd > 9 Then indd = 9
If indd > 0 Then
pros = pros + 1
attivital(pros, 0) = t_numd
For jj2 = 1 To indd
attivital(pros, jj2) = trdoc(jj2)
Next
End If
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<ConstraintMinDaysBetweenActivities>")
Loop
'Stop
' legge file activities per room e attivita con piu docenti
NEWF = FN
fafile = InStr(NEWF, "data_and_timetable")
NEWF = Mid(NEWF, 1, fafile - 1) + "activities.xml"
If GUTF = 0 Then
Open NEWF For Input As #1
Do Until EOF(1)
Line Input #1, Riga
aa$ = Riga
Loop
Close #1
Else
FNI = NEWF
ConvertUTF8File
aa$ = fout
End If
For i1 = 1 To 1500
attivita(i1, 7) = 0
Next
trovaact = InStr(aa$, "<Activity>")
conta = 0
newatt = 0
Do While trovaact > 0
t_a = aa$: t_i = "<Activity>": t_f = "</Activity>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Id>": t_f = "</Id>"
trovadati
t_ind = t_res
t_a = peract: t_i = "<Day>": t_f = "</Day>"
trovadati
t_day = t_res
t_a = peract: t_i = "<Hour>": t_f = "</Hour>"
trovadati
t_ora = t_res
t_a = peract: t_i = "<Room>": t_f = "</Room>"
trovadati
t_room = t_res
hatt = 0
For i1 = 1 To nhh
If ore(i1) = t_ora Then hatt = i1
Next
gatt = 0
For i1 = 1 To ngg
If giorni(i1) = t_day Then gatt = i1
Next
If hatt * gatt = 0 Then Stop
If attivita(t_ind, 0) = "XX" Then
For i1 = 1 To ctmiste
If miste(i1, 1, 7) = t_ind Then
For i2 = 1 To 10
If miste(i1, i2, 7) = t_ind Then
miste(i1, i2, 3) = t_room
miste(i1, i2, 4) = gatt
miste(i1, i2, 5) = hatt
End If
Next
i1 = 1000
End If
Next
Else
newatt = newatt + 1
attivita(t_ind, 3) = t_room
attivita(t_ind, 4) = gatt
attivita(t_ind, 5) = hatt
End If
conta = conta + 1
If conta > 1499 Then Stop
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "Activity>")
Loop
'--------------
'----
'controllo ore mal poste
'----
For i1 = 1 To 1500
attivita(i1, 7) = 0
Next
ttrr = 0
'Stop
For j1 = 1 To pros
For i1 = 1 To 9
For i2 = i1 + 1 To 9
If ((attivital(j1, i1) > 0) And (attivital(j1, i2) > 0)) Then
gg1 = attivita(attivital(j1, i1), 4)
gg2 = attivita(attivital(j1, i2), 4)
If (gg1 <> "") And (gg2 <> "") Then
ming = attivital(i1, 0)
If Abs(gg1 - gg2) < ming Then
attivita(attivital(j1, i1), 7) = 1
attivita(attivital(j1, i2), 7) = 1
End If
End If
End If
Next
Next
Next
'----
'----
'elimina attivita vuote
'----
nattivita = 0
For i1 = 1 To 1500
If ((attivita(i1, 0) <> "") And (attivita(i1, 0) <> "XX")) Then
nattivita = nattivita + 1
serv(nattivita) = i1
End If
Next
For i1 = 1 To nattivita
For i2 = 0 To 7
attivita(i1, i2) = attivita(serv(i1), i2)
Next
For i2 = 0 To 3
attivital(i1, i2) = attivital(serv(i1), i2)
Next
Next
'----
'----
'inserisce in attivita le miste
'----
For i1 = 1 To ctmiste
For i2 = 1 To 10
If miste(i1, i2, 7) <> "" Then
nattivita = nattivita + 1
For i3 = 0 To 6
attivita(nattivita, i3) = miste(i1, i2, i3)
Next
attivita(nattivita, 7) = 0
End If
Next
Next
' TEST
'ActiveWorkbook.Sheets("test").Activate
'Range("b2").Select
'For i = 1 To nattivita
' If attivita(i, 0) = "XX" Then
' Stop
' For i1 = 1 To ctmiste
' If miste(i1, 1, 7) = i Then
' spo = 0
' For i2 = 1 To 10
' If miste(i1, i2, 6) = i Then
' For i3 = 0 To 6
' spo = spo + 1
' ActiveCell.Offset(i, spo).Value = miste(i1, i2, i3)
' Next
' End If
' Next
' i1 = 1500
' End If
' Next
' Else
' For j = 0 To 6
' ActiveCell.Offset(i, j).Value = attivita(i, j)
' Next
' End If
'Next
'Stop
aa$ = ""
'scrive elenco per docente
ActiveWorkbook.Sheets("DOCENTI").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("DOCENTI").Activate
Range("b5").Select
ActiveCell.Offset(-4, 1).Value = scuola
ActiveCell.Offset(-3, 1).Value = anno
kk = 0
For i1 = 1 To ngg
For i2 = 1 To nhh
kk = kk + 1
If i2 = 1 Then ActiveCell.Offset(-1, kk).Value = giorni(i1)
ActiveCell.Offset(0, kk).Value = ore(i2)
Next
Next
For i1 = 1 To ndoc
ActiveCell.Offset(i1, 0).Value = docenti(i1)
For i2 = 1 To nattivita
If attivita(i2, 0) = docenti(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6) 'ATTIVITA(X,6) = durata lezione
lora = (gg - 1) * nhh + hh + i3 - 1
prec = ActiveCell.Offset(i1, lora).Value
If prec <> "" Then prec = prec + "-"
ActiveCell.Offset(i1, lora).Value = prec + attivita(i2, 1)
If ((attivita(i2, 7) = 1) And (gcons = 1)) Then
ActiveCell.Offset(i1, lora).Font.ColorIndex = 3
End If
Next
End If
Next
Next
'---giorni liberi e troppe ore
Range("b5").Select
For i1 = 1 To ndoc
For i2 = 1 To ngg
nlez = 0
For i3 = 1 To nhh
lora = (i2 - 1) * nhh + i3
If ActiveCell.Offset(i1, lora).Value <> "" Then nlez = nlez + 1
Next
If ((nlez = 0) And (gliberi = 1)) Then
Range("b5").Select
pi1 = ActiveCell.Offset(i1, (i2 - 1) * nhh + 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(i1, i2 * nhh).Address
prange = pi1 + ":" + pi2
colorav (prange)
Range("b5").Select
End If
maxxd = maxhdocenti(i1)
'----troppe ore
If ((nlez > maxxd) And (gtroppe = 1)) Then
Range("b5").Select
pi1 = ActiveCell.Offset(i1, (i2 - 1) * nhh + 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(i1, i2 * nhh).Address
prange = pi1 + ":" + pi2
colorar (prange)
Range("b5").Select
End If
Next
Next
'---giorni liberi e troppe ore
'---bordi
tt = nhh * ngg
orizi = 0
orizf = tt
verti = -1
vertf = ndoc
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
Macroq (prange)
Range("b5").Select
For i = 1 To ngg
orizi = 1 + (i - 1) * nhh
orizf = i * nhh
verti = 1
vertf = ndoc
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
Macroq (prange)
Range("b5").Select
Next
kk = 0
For i1 = 1 To ngg
Range("b5").Select
pi1 = ActiveCell.Offset(-1, 1 + (i1 - 1) * nhh).Address
Range("b5").Select
pi2 = ActiveCell.Offset(-1, i1 * nhh).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
Next
Range("b5").Select
pi1 = ActiveCell.Offset(-4, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(-4, ngg * nhh - 1).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
'------
'---- scrive elenco per classe
ActiveWorkbook.Sheets("CLASSI").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CLASSI").Activate
Range("b5").Select
persc = 3 + nhh + 4
scendi = 0
For i1 = 1 To ncla
ActiveCell.Offset(scendi, 1).Value = scuola
ActiveCell.Offset(scendi + 1, 1).Value = anno
ActiveCell.Offset(scendi + 2, 0).Value = classi(i1)
For i2 = 1 To ngg
ActiveCell.Offset(scendi + 2, i2).Value = giorni(i2)
Next
For i2 = 1 To nhh
ActiveCell.Offset(scendi + 2 + i2, 0).Value = ore(i2)
Next
For i2 = 1 To nattivita
If attivita(i2, 1) = classi(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6)
lora = i3
ActiveCell.Offset(1 + scendi + lora + hh, gg).Value = attivita(i2, 0)
Next
End If
Next
'bordi
tt = ngg
orizi = 0
orizf = tt
verti = scendi + 2
vertf = 3 + (nhh - 1) + scendi
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim1 (prange)
For ii1 = 1 To nhh
orizi = 0
orizf = tt
verti = scendi + ii1 + 2
vertf = verti
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim2 (prange)
Next
Range("b5").Select
pi1 = ActiveCell.Offset(scendi, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(scendi, ngg).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
scendi = scendi + persc
Next
'--
'scrive elenco per classe completo
ActiveWorkbook.Sheets("CLASSIM").Activate
Range("a1:bb1500").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CLASSIM").Activate
Range("b5").Select
persc = 3 + nhh * 3 + 1 + 4
scendi = 0
For i1 = 1 To ncla
ActiveCell.Offset(scendi, 1).Value = scuola
ActiveCell.Offset(1 + scendi, 1).Value = anno
ActiveCell.Offset(2 + scendi, 0).Value = classi(i1)
For i2 = 1 To ngg
ActiveCell.Offset(scendi + 2, i2).Value = giorni(i2)
Next
For i2 = 1 To nhh
ActiveCell.Offset(scendi + i2 * 3, 0).Value = ore(i2)
Next
For i2 = 1 To nattivita
If attivita(i2, 1) = classi(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6)
lora = i3
gggg = scendi + 3 * (lora + hh - 1)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1), gg).Value = attivita(i2, 0)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1) + 1, gg).Value = attivita(i2, 2)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1) + 2, gg).Value = attivita(i2, 3)
Next
End If
Next
tt = ngg
orizi = 0
orizf = tt
verti = scendi + 2
vertf = 3 + (nhh - 1) * 3 + scendi + 2
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim1 (prange)
For ii1 = 1 To nhh
orizi = 0
orizf = tt
verti = scendi + (3 * ii1)
vertf = verti + 2
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim2 (prange)
Next
Range("b5").Select
pi1 = ActiveCell.Offset(scendi, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(scendi, ngg).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
scendi = scendi + persc
Next
'----
'---- cattedre
ActiveWorkbook.Sheets("CATTEDRE").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CATTEDRE").Activate
Range("b5").Select
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata
scendi = 0
For i1 = 1 To ndoc
For i2 = 1 To nattivita
If attivita(i2, 0) = docenti(i1) Then
numh = attivita(i2, 6)
trv1 = 0: trv2 = 0
For i3 = 1 To 20
If trv2 = 0 Then
If cattedre(i1, i3, 0) = "" Then trv2 = i3
End If
If (cattedre(i1, i3, 0) = attivita(i2, 1)) And (cattedre(i1, i3, 1) = attivita(i2, 2)) Then trv1 = i3
Next
If trv1 <> 0 Then 'gia classe
cattedreh(i1, trv1) = cattedreh(i1, trv1) + numh
Else
cattedre(i1, trv2, 0) = attivita(i2, 1)
cattedre(i1, trv2, 1) = attivita(i2, 2)
cattedreh(i1, trv2) = numh + cattedreh(i1, trv2)
End If
End If
Next
Next
For i1 = 1 To ndoc
toth = 0
For i3 = 1 To 20
toth = toth + cattedreh(i1, i3)
Next
scendi = scendi + 1
solo1 = 1
For i3 = 1 To 20
If cattedre(i1, i3, 0) <> "" Then
If i3 = 2 Then solo1 = 0
If i3 = 1 Then
ActiveCell.Offset(scendi, 0).Value = docenti(i1)
ActiveCell.Offset(scendi + 1, 0).Value = "h :" + Str(toth)
End If
ActiveCell.Offset(scendi, 1).Value = cattedre(i1, i3, 0)
ActiveCell.Offset(scendi, 2).Value = cattedre(i1, i3, 1)
ActiveCell.Offset(scendi, 3).Value = cattedreh(i1, i3)
scendi = scendi + 1
End If
Next
If solo1 = 1 Then scendi = scendi + 1
Next
ActiveWorkbook.Sheets("partenza").Activate
Range("a1").Select
End Sub
spero qualcuno possa aiutarmi.
premetto che sono ignorante in materia...
Ho compilato sul mio iMac questo software (FET, timetabling software):
https://sites.google.com/site/ilpassodellupo/home
per fare l'orario scolastico del mio Liceo.
Tutto ok, però quando ho ultimato il lavoro mi sono accorto che non è agevole la stampa finale dell'orario (L'orario prodotto è registrato per mezzo di più file in formato xml e html).
Un utente ha ideato uno script, un particolare foglio di calcolo contenente una macro capace di importare in Excel l'orario generato da FET dicendo che funziona solo su Excel e non con gli altri software perché è stato costruito con visualbasic e non con java.
E' una breve elaborazione, produce una serie di fogli contenenti tutte le informazioni necessarie a distribuire e stampare l'orario con la massima libertà.
E' utile anche per fare piccoli ritocchi senza aprire il software principale (che è mooolto laborioso)...
Ho scaricato lo script : Fet_import_in_excel_UTF8.zip dal forum
http://lalescu.ro/liviu/fet/forum/index.php?action=dlattach;topic=504.0;attach=149
e lo aperto con Microsoft Excel 2011 v.14.3.6
mi chiede se attivare la Macro
Ok
mi risulta sempre :
Errore di runtime "1004" :
Metodo "GetOpenFilename" dell'oggetto "_Application" non riuscito.
con i pulsanti :
Continua (non attivo)
Fine
Debug
?
Se seleziono "Debug" mi compaiono 4 finestre :
Progetto
Proprietà
Fet_import_in_excel_UTF8.XLS - Modulo2 (codice)
Fet_import_in_excel_UTF8.XLS - Modulo3 (codice)
evidenziandomi in giallo :
FN = Application.GetOpenFilename(FileFilter:="fet File (*.fet), *.fet", Title:="Seleziona il file <.fet> che vuoi elaborare DALLA CARTELLA fet-results/timetables")
sul FORUM di FET dicono di abilitare le macro: menù Strumenti/ Macro/ Protezione ... seleziona il livello medio (non di più, altrimenti non funzionerà).
riferito probabilmente alla versione di Windows perchè io ho cercato ma non sono riuscito a trovare il corrispondente su excel in mac osx....
ho caricato anche excel (per windows XP) sul mio VMware fusion ma niente, stesso problema
non so più che fare
qualche buon'anima non in vacanza mi può dare qualche suggerimento?
grazie mille
Pg
su modulo 2 :
Sub trovadati()
t_res = ""
trovai = InStr(t_a, t_i)
trovaf = InStr(t_a, t_f)
If trovai = 0 Then Exit Sub
t_res = Mid(t_a, trovai + Len(t_i), trovaf - trovai - Len(t_f) + 1)
Mid(t_a, trovai, 3) = " "
Mid(t_a, trovaf, 3) = " "
'Stop
End Sub
Sub Macroq(prange)
'
' Macroq Macro
' Macro registrata il 10/08/2009 da pc
'
' Scelta rapida da tastiera: CTRL+s
'
Range(prange).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sub perclassim1(rang)
'
'
Range(rang).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub perclassim2(rang)
'
Range(rang).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub colorav(prange)
'
Range(prange).Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End Sub
Sub perclassim()
'
' Macro1 Macro
' Macro registrata il 16/08/2009 da pc
'
' Scelta rapida da tastiera: CTRL+r
'
Range("C45:H45").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("C51:H64").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C54:H56").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C57:H59").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("C60:H62").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sub unisce(ranges)
'
' Macro2 Macro
' Macro registrata il 17/08/2009 da PC
'
' Scelta rapida da tastiera: CTRL+t
'
Range(ranges).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End Sub
Sub colorar(prange)
'
Range(prange).Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
End Sub
su Modulo 3 :
Public t_a, t_i, t_f, t_res, trovaf, FN, fint, fout, FNI
Private Const CP_UTF8 = 65001
Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Function sUTF8ToUni(bySrc() As Byte) As String
' Converts a UTF-8 byte array to a Unicode string
Dim lBytes As Long, lNC As Long, lRet As Long
lBytes = UBound(bySrc) - LBound(bySrc) + 1
lNC = lBytes
sUTF8ToUni = String$(lNC, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
sUTF8ToUni = Left$(sUTF8ToUni, lRet)
End Function
Public Sub ConvertUTF8File()
Dim iFile As Integer, bData() As Byte, sData As String, lSize As Long
' Get the incoming data size
lSize = FileLen(FNI)
If lSize > 0 Then
ReDim bData(0 To lSize - 1)
' Read the existing UTF-8 file
iFile = FreeFile()
Open FNI For Binary As #iFile
Get #iFile, , bData
Close #iFile
' Convert all the data to Unicode (all VB Strings are Unicode)
sData = sUTF8ToUni(bData)
Else
sData = ""
End If
fout = sData
' Now write it all out to the ANSI file
' iFile = FreeFile()
' Open sANSIFile For Output As #iFile
' Print #iFile, sData
' Close iFile
End Sub
Sub legge()
Dim docenti(120)
Dim maxhdocenti(120) As Integer
Dim attivita(1500, 7) As String
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata 7 malposta
Dim attivital(1500, 9) As Integer
' in '0' lontananza attivita lontana di '1' e in '2' attivita lontana di '3'
Dim miste(200, 10, 7) As String
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata 7=INDICE IN attivita
Dim trdoc(20)
Dim trcla(20)
Dim giorni(15)
Dim ore(12)
Dim classi(200)
Dim cattedre(100, 20, 1)
Dim cattedreh(100, 20) As Integer
Dim serv(1500) As Integer
FN = Application.GetOpenFilename(FileFilter:="fet File (*.fet), *.fet", Title:="Seleziona il file <.fet> che vuoi elaborare DALLA CARTELLA fet-results/timetables")
'
If FN = False Then
MsgBox "programma terminato, non hai scelto il file"
Exit Sub
End If
'
'legge dati scuola
ActiveWorkbook.Sheets("partenza").Activate
Range("c3").Select
scuola = ActiveCell.Offset(0, 0).Value
Range("c6").Select
anno = ActiveCell.Offset(0, 0).Value
Range("c8").Select
If ActiveCell.Offset(0, 0).Value = "1" Then GUTF = 1 Else GUTF = 0
Range("c9").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gliberi = 1 Else gliberi = 0
Range("c10").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gtroppe = 1 Else gtroppe = 0
Range("c11").Select
If ActiveCell.Offset(0, 0).Value = "1" Then gcons = 1 Else gcons = 0
If GUTF = 0 Then
Open FN For Input As #1
Do Until EOF(1)
Line Input #1, Riga
aa$ = Riga
aa1$ = aa$
Loop
Close #1
Else
FNI = FN
ConvertUTF8File
aa$ = fout
aa1$ = fout
End If
sdocente = "<Teacher>"
fdocente = "</Teacher>"
ldocente = Len(sdocente)
sclasse = "<Students name="
fclasse = "</Students"
lclasse = Len(sclasse)
sgiorno = "Day name="
fgiorno = "/Day"
lgiorno = Len(sgiorno)
sore = "<Hour name="
fore = "</Hour"
lore = Len(sore)
saula = "<Room name="
faula = "</Room"
laula = Len(saula)
'
'--- docenti
ndoc = 0
t_a = aa$: t_i = "<Teachers_List>": t_f = "</Teachers_List>"
trovadati
perdoc = t_res
trovadoc = InStr(perdoc, "<Name>")
indd = 0
Do While trovadoc > 0
t_a = perdoc: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
docenti(indd) = t_res
perdoc = t_a
trovadoc = InStr(perdoc, "<Name>")
If indd > 99 Then Stop
Loop
ndoc = indd
'---
'----- classi
ncla = 0
t_a = aa$: t_i = "<Students_List>": t_f = "</Students_List>"
trovadati
percla = t_res
trovacla = InStr(percla, "<Name>")
indd = 0
Do While trovacla > 0
t_a = percla: t_i = "<Name>": t_f = "</Name>"
trovadati
If Len(t_res) > 1 Then
indd = indd + 1
classi(indd) = t_res
End If
percla = t_a
trovacla = InStr(percla, "<Name>")
If indd > 199 Then Stop
Loop
ncla = indd
'---
'------ ore e giorni
ngg = 0: nhh = 0
t_a = aa$: t_i = "<Hours_List>": t_f = "</Hours_List>"
trovadati
perore = t_res
trovaore = InStr(perore, "<Name>")
indd = 0
Do While trovaore > 0
t_a = perore: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
ore(indd) = t_res
perore = t_a
trovaore = InStr(perore, "<Name>")
If indd > 50 Then Stop
Loop
nhh = indd
t_a = aa$: t_i = "<Days_List>": t_f = "</Days_List>"
trovadati
perg = t_res
trovag = InStr(perg, "<Name>")
indd = 0
Do While trovag > 0
t_a = perg: t_i = "<Name>": t_f = "</Name>"
trovadati
indd = indd + 1
giorni(indd) = t_res
perg = t_a
trovag = InStr(perg, "<Name>")
If indd > 50 Then Stop
Loop
ngg = indd
'---
'---- lezioni
conta = 0
ctmiste = 0
trovaact = InStr(aa$, "<Activity>")
Do While trovaact > 0
t_a = aa$: t_i = "<Activity>": t_f = "</Activity>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Id>": t_f = "</Id>"
trovadati
t_ind = t_res
t_a = peract: t_i = "<Subject>": t_f = "</Subject>"
trovadati
materia = t_res
t_a = peract: t_i = "<Duration>": t_f = "</Duration>"
trovadati
durata = t_res
' possibili piu docenti
trovadoc = InStr(peract, "<Teacher>")
indd = 0
Do While trovadoc > 0
t_a = peract: t_i = "<Teacher>": t_f = "</Teacher>"
trovadati
indd = indd + 1
trdoc(indd) = t_res
peract = t_a
trovadoc = InStr(peract, "<Teacher>")
Loop
' possibili piu classi
trovacla = InStr(peract, "<Students>")
indc = 0
Do While trovacla > 0
t_a = peract: t_i = "<Students>": t_f = "</Students>"
trovadati
indc = indc + 1
trcla(indc) = t_res
peract = t_a
trovacla = InStr(peract, "<Students>")
Loop
'
fatto = 0
If (indd = 1) And (indc = 1) Then
attivita(t_ind, 0) = trdoc(1)
attivita(t_ind, 1) = trcla(1)
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
fatto = 1
End If
If (indd > 1) And (indc = indd) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(ii)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If (indc > indd) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indc
miste(ctmiste, ii, 0) = trdoc(1)
miste(ctmiste, ii, 1) = trcla(ii)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If (indd > indc) Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
attivita(t_ind, 6) = durata
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(1)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
If fatto = 0 Then
ctmiste = ctmiste + 1
attivita(t_ind, 0) = "XX"
attivita(t_ind, 1) = "XX"
attivita(t_ind, 2) = materia
For ii = 1 To indd
miste(ctmiste, ii, 0) = trdoc(ii)
miste(ctmiste, ii, 1) = trcla(1)
miste(ctmiste, ii, 2) = materia
miste(ctmiste, ii, 3) = ""
miste(ctmiste, ii, 6) = durata
miste(ctmiste, ii, 7) = t_ind
Next
fatto = 1
End If
conta = conta + 1
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<Activity>")
If conta > 1999 Then Stop
Loop
'---------------
'------------------------------------------------------------ errore di max ore
For ji = 1 To ndoc
maxhdocenti(ji) = 100
Next
'------------------
aa$ = aa1$ 'ricostruisce quanto letto nel file e tagliato routine precedente
'------------------
trovaact = InStr(aa$, "<ConstraintTeachersMaxHoursDaily>")
If trovaact > 0 Then
t_a = aa$: t_i = "<ConstraintTeachersMaxHoursDaily>": t_f = "</ConstraintTeachersMaxHoursDaily>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Maximum_Hours_Daily>": t_f = "</Maximum_Hours_Daily>"
trovadati
t_ind = t_res
t_maxd = t_res
For ji = 1 To ndoc
If maxhdocenti(ji) = 100 Then maxhdocenti(ji) = t_maxd
Next
End If
trovaact = InStr(aa$, "<ConstraintTeacherMaxHoursDaily>")
Do While trovaact > 0
t_a = aa$: t_i = "<ConstraintTeacherMaxHoursDaily>": t_f = "</ConstraintTeacherMaxHoursDaily>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Teacher_Name>": t_f = "</Teacher_Name>"
trovadati
t_ind = t_res
t_nomed = t_res
t_a = peract: t_i = "<Maximum_Hours_Daily>": t_f = "</Maximum_Hours_Daily>"
trovadati
t_ind = t_res
t_maxd = t_res
If t_nomed = "" Then
Else
For ji = 1 To ndoc
If t_nomed = docenti(ji) Then maxhdocenti(ji) = t_maxd: ji = ndoc + 1: contamh = 1 + contamh
Next
End If
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<ConstraintTeacherMaxHoursDaily>")
If conta > 1999 Then Stop
Loop
'------------------------------------------------------------ errore di ore vicine
'------------------
aa$ = aa1$ 'ricostruisce quanto letto nel file e tagliato routine precedente
'------------------
For ji = 1 To 1500
For j2 = 0 To 5
attivital(ji, j2) = 0
Next
Next
pros = 0
trovaact = InStr(aa$, "<ConstraintMinDaysBetweenActivities>")
luup = 0
Do While trovaact > 0
luup = luup + 1
t_a = aa$: t_i = "<ConstraintMinDaysBetweenActivities>": t_f = "</ConstraintMinDaysBetweenActivities>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Number_of_Activities>": t_f = "</Number_of_Activities>"
trovadati
t_ind = t_res
t_numat = t_res
t_a = peract: t_i = "<MinDays>": t_f = "</MinDays>"
trovadati
t_numd = t_res
' trova piu attivita
trovaatt = InStr(peract, "<Activity_Id>")
indd = 0
Do While trovaatt > 0
t_a = peract: t_i = "<Activity_Id>": t_f = "</Activity_Id>"
trovadati
indd = indd + 1
trdoc(indd) = t_res 'vettore non piu in uso
peract = t_a
trovaatt = InStr(peract, "<Activity_Id>")
Loop
If indd > 9 Then indd = 9
If indd > 0 Then
pros = pros + 1
attivital(pros, 0) = t_numd
For jj2 = 1 To indd
attivital(pros, jj2) = trdoc(jj2)
Next
End If
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "<ConstraintMinDaysBetweenActivities>")
Loop
'Stop
' legge file activities per room e attivita con piu docenti
NEWF = FN
fafile = InStr(NEWF, "data_and_timetable")
NEWF = Mid(NEWF, 1, fafile - 1) + "activities.xml"
If GUTF = 0 Then
Open NEWF For Input As #1
Do Until EOF(1)
Line Input #1, Riga
aa$ = Riga
Loop
Close #1
Else
FNI = NEWF
ConvertUTF8File
aa$ = fout
End If
For i1 = 1 To 1500
attivita(i1, 7) = 0
Next
trovaact = InStr(aa$, "<Activity>")
conta = 0
newatt = 0
Do While trovaact > 0
t_a = aa$: t_i = "<Activity>": t_f = "</Activity>"
trovadati
peract = t_res
lmax = trovaf
t_a = peract: t_i = "<Id>": t_f = "</Id>"
trovadati
t_ind = t_res
t_a = peract: t_i = "<Day>": t_f = "</Day>"
trovadati
t_day = t_res
t_a = peract: t_i = "<Hour>": t_f = "</Hour>"
trovadati
t_ora = t_res
t_a = peract: t_i = "<Room>": t_f = "</Room>"
trovadati
t_room = t_res
hatt = 0
For i1 = 1 To nhh
If ore(i1) = t_ora Then hatt = i1
Next
gatt = 0
For i1 = 1 To ngg
If giorni(i1) = t_day Then gatt = i1
Next
If hatt * gatt = 0 Then Stop
If attivita(t_ind, 0) = "XX" Then
For i1 = 1 To ctmiste
If miste(i1, 1, 7) = t_ind Then
For i2 = 1 To 10
If miste(i1, i2, 7) = t_ind Then
miste(i1, i2, 3) = t_room
miste(i1, i2, 4) = gatt
miste(i1, i2, 5) = hatt
End If
Next
i1 = 1000
End If
Next
Else
newatt = newatt + 1
attivita(t_ind, 3) = t_room
attivita(t_ind, 4) = gatt
attivita(t_ind, 5) = hatt
End If
conta = conta + 1
If conta > 1499 Then Stop
aa$ = Mid(aa$, lmax + 4)
trovaact = InStr(2, aa$, "Activity>")
Loop
'--------------
'----
'controllo ore mal poste
'----
For i1 = 1 To 1500
attivita(i1, 7) = 0
Next
ttrr = 0
'Stop
For j1 = 1 To pros
For i1 = 1 To 9
For i2 = i1 + 1 To 9
If ((attivital(j1, i1) > 0) And (attivital(j1, i2) > 0)) Then
gg1 = attivita(attivital(j1, i1), 4)
gg2 = attivita(attivital(j1, i2), 4)
If (gg1 <> "") And (gg2 <> "") Then
ming = attivital(i1, 0)
If Abs(gg1 - gg2) < ming Then
attivita(attivital(j1, i1), 7) = 1
attivita(attivital(j1, i2), 7) = 1
End If
End If
End If
Next
Next
Next
'----
'----
'elimina attivita vuote
'----
nattivita = 0
For i1 = 1 To 1500
If ((attivita(i1, 0) <> "") And (attivita(i1, 0) <> "XX")) Then
nattivita = nattivita + 1
serv(nattivita) = i1
End If
Next
For i1 = 1 To nattivita
For i2 = 0 To 7
attivita(i1, i2) = attivita(serv(i1), i2)
Next
For i2 = 0 To 3
attivital(i1, i2) = attivital(serv(i1), i2)
Next
Next
'----
'----
'inserisce in attivita le miste
'----
For i1 = 1 To ctmiste
For i2 = 1 To 10
If miste(i1, i2, 7) <> "" Then
nattivita = nattivita + 1
For i3 = 0 To 6
attivita(nattivita, i3) = miste(i1, i2, i3)
Next
attivita(nattivita, 7) = 0
End If
Next
Next
' TEST
'ActiveWorkbook.Sheets("test").Activate
'Range("b2").Select
'For i = 1 To nattivita
' If attivita(i, 0) = "XX" Then
' Stop
' For i1 = 1 To ctmiste
' If miste(i1, 1, 7) = i Then
' spo = 0
' For i2 = 1 To 10
' If miste(i1, i2, 6) = i Then
' For i3 = 0 To 6
' spo = spo + 1
' ActiveCell.Offset(i, spo).Value = miste(i1, i2, i3)
' Next
' End If
' Next
' i1 = 1500
' End If
' Next
' Else
' For j = 0 To 6
' ActiveCell.Offset(i, j).Value = attivita(i, j)
' Next
' End If
'Next
'Stop
aa$ = ""
'scrive elenco per docente
ActiveWorkbook.Sheets("DOCENTI").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("DOCENTI").Activate
Range("b5").Select
ActiveCell.Offset(-4, 1).Value = scuola
ActiveCell.Offset(-3, 1).Value = anno
kk = 0
For i1 = 1 To ngg
For i2 = 1 To nhh
kk = kk + 1
If i2 = 1 Then ActiveCell.Offset(-1, kk).Value = giorni(i1)
ActiveCell.Offset(0, kk).Value = ore(i2)
Next
Next
For i1 = 1 To ndoc
ActiveCell.Offset(i1, 0).Value = docenti(i1)
For i2 = 1 To nattivita
If attivita(i2, 0) = docenti(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6) 'ATTIVITA(X,6) = durata lezione
lora = (gg - 1) * nhh + hh + i3 - 1
prec = ActiveCell.Offset(i1, lora).Value
If prec <> "" Then prec = prec + "-"
ActiveCell.Offset(i1, lora).Value = prec + attivita(i2, 1)
If ((attivita(i2, 7) = 1) And (gcons = 1)) Then
ActiveCell.Offset(i1, lora).Font.ColorIndex = 3
End If
Next
End If
Next
Next
'---giorni liberi e troppe ore
Range("b5").Select
For i1 = 1 To ndoc
For i2 = 1 To ngg
nlez = 0
For i3 = 1 To nhh
lora = (i2 - 1) * nhh + i3
If ActiveCell.Offset(i1, lora).Value <> "" Then nlez = nlez + 1
Next
If ((nlez = 0) And (gliberi = 1)) Then
Range("b5").Select
pi1 = ActiveCell.Offset(i1, (i2 - 1) * nhh + 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(i1, i2 * nhh).Address
prange = pi1 + ":" + pi2
colorav (prange)
Range("b5").Select
End If
maxxd = maxhdocenti(i1)
'----troppe ore
If ((nlez > maxxd) And (gtroppe = 1)) Then
Range("b5").Select
pi1 = ActiveCell.Offset(i1, (i2 - 1) * nhh + 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(i1, i2 * nhh).Address
prange = pi1 + ":" + pi2
colorar (prange)
Range("b5").Select
End If
Next
Next
'---giorni liberi e troppe ore
'---bordi
tt = nhh * ngg
orizi = 0
orizf = tt
verti = -1
vertf = ndoc
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
Macroq (prange)
Range("b5").Select
For i = 1 To ngg
orizi = 1 + (i - 1) * nhh
orizf = i * nhh
verti = 1
vertf = ndoc
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
Macroq (prange)
Range("b5").Select
Next
kk = 0
For i1 = 1 To ngg
Range("b5").Select
pi1 = ActiveCell.Offset(-1, 1 + (i1 - 1) * nhh).Address
Range("b5").Select
pi2 = ActiveCell.Offset(-1, i1 * nhh).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
Next
Range("b5").Select
pi1 = ActiveCell.Offset(-4, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(-4, ngg * nhh - 1).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
'------
'---- scrive elenco per classe
ActiveWorkbook.Sheets("CLASSI").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CLASSI").Activate
Range("b5").Select
persc = 3 + nhh + 4
scendi = 0
For i1 = 1 To ncla
ActiveCell.Offset(scendi, 1).Value = scuola
ActiveCell.Offset(scendi + 1, 1).Value = anno
ActiveCell.Offset(scendi + 2, 0).Value = classi(i1)
For i2 = 1 To ngg
ActiveCell.Offset(scendi + 2, i2).Value = giorni(i2)
Next
For i2 = 1 To nhh
ActiveCell.Offset(scendi + 2 + i2, 0).Value = ore(i2)
Next
For i2 = 1 To nattivita
If attivita(i2, 1) = classi(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6)
lora = i3
ActiveCell.Offset(1 + scendi + lora + hh, gg).Value = attivita(i2, 0)
Next
End If
Next
'bordi
tt = ngg
orizi = 0
orizf = tt
verti = scendi + 2
vertf = 3 + (nhh - 1) + scendi
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim1 (prange)
For ii1 = 1 To nhh
orizi = 0
orizf = tt
verti = scendi + ii1 + 2
vertf = verti
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim2 (prange)
Next
Range("b5").Select
pi1 = ActiveCell.Offset(scendi, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(scendi, ngg).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
scendi = scendi + persc
Next
'--
'scrive elenco per classe completo
ActiveWorkbook.Sheets("CLASSIM").Activate
Range("a1:bb1500").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CLASSIM").Activate
Range("b5").Select
persc = 3 + nhh * 3 + 1 + 4
scendi = 0
For i1 = 1 To ncla
ActiveCell.Offset(scendi, 1).Value = scuola
ActiveCell.Offset(1 + scendi, 1).Value = anno
ActiveCell.Offset(2 + scendi, 0).Value = classi(i1)
For i2 = 1 To ngg
ActiveCell.Offset(scendi + 2, i2).Value = giorni(i2)
Next
For i2 = 1 To nhh
ActiveCell.Offset(scendi + i2 * 3, 0).Value = ore(i2)
Next
For i2 = 1 To nattivita
If attivita(i2, 1) = classi(i1) Then
gg = attivita(i2, 4)
hh = attivita(i2, 5)
For i3 = 1 To attivita(i2, 6)
lora = i3
gggg = scendi + 3 * (lora + hh - 1)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1), gg).Value = attivita(i2, 0)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1) + 1, gg).Value = attivita(i2, 2)
ActiveCell.Offset(scendi + 3 * (lora + hh - 1) + 2, gg).Value = attivita(i2, 3)
Next
End If
Next
tt = ngg
orizi = 0
orizf = tt
verti = scendi + 2
vertf = 3 + (nhh - 1) * 3 + scendi + 2
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim1 (prange)
For ii1 = 1 To nhh
orizi = 0
orizf = tt
verti = scendi + (3 * ii1)
vertf = verti + 2
Range("b5").Select
pi1 = ActiveCell.Offset(verti, orizi).Address
Range("b5").Select
pi2 = ActiveCell.Offset(vertf, orizf).Address
prange = pi1 + ":" + pi2
perclassim2 (prange)
Next
Range("b5").Select
pi1 = ActiveCell.Offset(scendi, 1).Address
Range("b5").Select
pi2 = ActiveCell.Offset(scendi, ngg).Address
prange = pi1 + ":" + pi2
unisce (prange)
Range("b5").Select
scendi = scendi + persc
Next
'----
'---- cattedre
ActiveWorkbook.Sheets("CATTEDRE").Activate
Range("a1:bb1000").Select
Selection.EntireRow.Delete
Columns("A:cc").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Sheets("CATTEDRE").Activate
Range("b5").Select
' 0=docente 1=classe 2=materia 3=aula 4 giorno 5 ora 6 durata
scendi = 0
For i1 = 1 To ndoc
For i2 = 1 To nattivita
If attivita(i2, 0) = docenti(i1) Then
numh = attivita(i2, 6)
trv1 = 0: trv2 = 0
For i3 = 1 To 20
If trv2 = 0 Then
If cattedre(i1, i3, 0) = "" Then trv2 = i3
End If
If (cattedre(i1, i3, 0) = attivita(i2, 1)) And (cattedre(i1, i3, 1) = attivita(i2, 2)) Then trv1 = i3
Next
If trv1 <> 0 Then 'gia classe
cattedreh(i1, trv1) = cattedreh(i1, trv1) + numh
Else
cattedre(i1, trv2, 0) = attivita(i2, 1)
cattedre(i1, trv2, 1) = attivita(i2, 2)
cattedreh(i1, trv2) = numh + cattedreh(i1, trv2)
End If
End If
Next
Next
For i1 = 1 To ndoc
toth = 0
For i3 = 1 To 20
toth = toth + cattedreh(i1, i3)
Next
scendi = scendi + 1
solo1 = 1
For i3 = 1 To 20
If cattedre(i1, i3, 0) <> "" Then
If i3 = 2 Then solo1 = 0
If i3 = 1 Then
ActiveCell.Offset(scendi, 0).Value = docenti(i1)
ActiveCell.Offset(scendi + 1, 0).Value = "h :" + Str(toth)
End If
ActiveCell.Offset(scendi, 1).Value = cattedre(i1, i3, 0)
ActiveCell.Offset(scendi, 2).Value = cattedre(i1, i3, 1)
ActiveCell.Offset(scendi, 3).Value = cattedreh(i1, i3)
scendi = scendi + 1
End If
Next
If solo1 = 1 Then scendi = scendi + 1
Next
ActiveWorkbook.Sheets("partenza").Activate
Range("a1").Select
End Sub
Jack
Aug 12, 2013, 4:28:08 AM8/12/13
to
Pg <simoni.pi...@gmail.com> wrote:
> non so piů che fare
>
> qualche buon'anima non in vacanza mi puň dare qualche suggerimento?
Chiedi a chi a scritto lo script e/o direttamente sul forum di FET.
Ciao Jack
--
Yoda of Borg am I! Assimilated shall you be! Futile resistance is, hmm?
> non so piů che fare
>
> qualche buon'anima non in vacanza mi puň dare qualche suggerimento?
Chiedi a chi a scritto lo script e/o direttamente sul forum di FET.
Ciao Jack
--
Yoda of Borg am I! Assimilated shall you be! Futile resistance is, hmm?
Jack
Aug 12, 2013, 4:31:56 AM8/12/13
to
Pg <simoni.pi...@gmail.com> wrote:
> Ciao,
> spero qualcuno possa aiutarmi.
> premetto che sono ignorante in materia...
>
> Ho compilato sul mio iMac questo software (FET, timetabling software):
tra l'altro esiste una versione gia' compilata:
> Ciao,
> spero qualcuno possa aiutarmi.
> premetto che sono ignorante in materia...
>
> Ho compilato sul mio iMac questo software (FET, timetabling software):
http://lalescu.ro/liviu/fet/toolslinks.html
0 new messages