Rem Attribute VBA_ModuleType=VBAUnknown Option Explicit Sub ThisWorkbook Rem End Sub Function cerca(ByVal MiaData As Date, area As String, ByVal offset As Integer) As String Dim oRange as Object Dim i As Integer Dim m As Integer Dim oRN As Object Dim d as Date Dim Risultato As String oRange = ThisComponent.NamedRanges.GetByName(area).ReferredCells Risultato = "" oRN = oRange.getRangeAddress() m = oRN.endRow - oRN.StartRow - 1 For i = 1 To m If oRange.getcellbyposition(0, i).Value = MiaData Then Risultato = Risultato & oRange.getcellbyposition(offset-1, i).getString () & Chr(13) & " " End If Next i cerca = Risultato End Function Function Scadenza(ByVal DataRif As Date, Scadenziario As String) As String Dim DataStd As Date DataStd = DateSerial(1900, Month(DataRif), Day(DataRif)) Scadenza = cerca(DataRif, Scadenziario, 5) & cerca(DataStd, Scadenziario, 5) End Function Function Riunioni(ByVal DataRif As Date, Scadenziario_R As String) As String Riunioni = cerca(DataRif, Scadenziario_R, 5) End Function Sub Macro1 Rem Oo 2.0 -{gt} 680 Rem NeoOficeJ -{gt} 645 REM msgbox ThisComponent.Sheets(0).Dbg_Properties msgbox ThisComponent.Sheets(0).Dbg_Methods rem msgbox GetSolarVersion () ' Dbg_Methods End Sub REM Situazione per Deskjet, che non rovescia i fogli Sub RetriCrescenti Dim Cella as String Dim Formula as String Dim Riga as Integer REM Prima pagina: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("P3").getCellByPosition (0,0).Formula="=L291" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("T3").getCellByPosition (0,0).Formula="=H291" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("X3").getCellByPosition (0,0).Formula="=D291" REM Ciclo sulle pagine successive for Riga=19 to 307 step 16 Cella = "P" + Riga Formula="=P" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="T"+Riga Formula="=T" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="X"+Riga Formula="=X" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula next Riga End Sub REM Situazione con invertitore di fogli -- in realtą devo invertite i fronti!!! Sub RetriDecrescenti Dim Cella as String Dim Formula as String Dim Riga as Integer REM Prima pagina: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("P307").getCellByPosition (0,0).Formula="=L3+7" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("T307").getCellByPosition (0,0).Formula="=H3+7" REM Uso D19 invece di D3+7 perche D3 fa parte della copertina ed č vuoto e D19 corrisponde a "una settiman dopo" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("X307").getCellByPosition (0,0).Formula="=D19" REM Ciclo sulle pagine successive for Riga=3 to 291 step 16 Cella = "P" + Riga Formula="=P" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="T"+Riga Formula="=T" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="X"+Riga Formula="=X" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula next Riga End Sub sub macro2 dim Formula as String dim Riga as Integer Riga=3 Formula = "=P" + (Riga + 2) + "+1" msgbox Formula REM ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("ai1").getCellByPosition (0,0).Formula="=z2" end sub REM Situazione per Deskjet, che non rovescia i fogli Sub FrontiDecrescenti Dim Cella as String Dim Formula as String Dim Riga as Integer Dim iI As Integer Dim oCell As Object Dim oNextCell As Object Dim bNotEmpty As Boolean Dim dispatcher As Object Dim Array () Dim document As Object Rem Aggiungo la riga dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame REM Copia la prima pagina dalla seconda Rem Seleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B18:E32")) Rem Copia le celle dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) Rem Riseleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B2:E17")) Rem Incolla le celle dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) REM Ciclo sulle pagine successive for Riga=3 to 291 step 16 Cella = "D" + Riga Formula="=D" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="H"+Riga Formula="=H" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="L"+Riga Formula="=L" + (Riga+28) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula next Riga REM Copia l'intestazione Rem Seleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B322:E337")) Rem Copia le celle dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) Rem Riseleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B306:E321")) Rem Incolla le celle dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) REM Prima pagina: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("D291").getCellByPosition (0,0).Formula="=DATE($B$1;9;1)-WEEKDAY(DATE(C312;8;23))" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("H307").getCellByPosition (0,0).Formula="=D15+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("L307").getCellByPosition (0,0).Formula="=H15+1" REM Prima pagina retri: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("P3").getCellByPosition (0,0).Formula="=L291" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("T3").getCellByPosition (0,0).Formula="=H291" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("X3").getCellByPosition (0,0).Formula="=D291" End Sub REM Situazione per Lasetjet, che roveswcia i fogli Sub FrontiCrescenti Dim Cella as String Dim Formula as String Dim Riga as Integer Dim iI As Integer Dim oCell As Object Dim oNextCell As Object Dim bNotEmpty As Boolean Dim dispatcher As Object Dim Array () Dim document As Object ThisComponent.LockControllers Rem Aggiungo la riga dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame REM Copia la prima pagina dalla seconda Rem Seleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B290:E305")) Rem Copia le celle dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) Rem Riseleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B306:E321")) Rem Incolla le celle dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) REM Ciclo sulle pagine successive for Riga=19 to 307 step 16 Cella = "D" + Riga Formula="=D" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="H"+Riga Formula="=H" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula Cella="L"+Riga Formula="=L" + (Riga-4) + "+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(Cella).getCellByPosition (0,0).Formula=Formula next Riga REM Copia l'intestazione Rem Seleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B322:E337")) Rem Copia le celle dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) Rem Riseleziona le celle ThisComponent.CurrentController.Select(ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("B2:E17")) Rem Incolla le celle dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) REM Prima pagina: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("D19").getCellByPosition (0,0).Formula="=DATE($B$1;9;1)-WEEKDAY(DATE(C312;8;23))" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("H3").getCellByPosition (0,0).Formula="=D319+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("L3").getCellByPosition (0,0).Formula="=H319+1" REM Prima pagina retri: fissi ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("P3").getCellByPosition (0,0).Formula="=T319+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("T3").getCellByPosition (0,0).Formula="=X319+1" ThisComponent.CurrentController.ActiveSheet.getCellRangeByName("X3").getCellByPosition (0,0).Formula="=D19" ThisComponent.CalculateAll() ThisComponent.UnlockControllers End Sub
Le macro - ThisWorkbook