Newsgroup: it.comp.macintosh
Titolo: FET (timetabling software) ed esportazione in Microsoft Excel

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
 

 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?

 Ho compilato sul mio iMac questo software (FET, timetabling software):
 
tra l'altro esiste una versione gia' compilata:
 
http://lalescu.ro/liviu/fet/toolslinks.html
 
