74 - Planner - ThisWorkbook

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

© Ing. Stefano Salvi - released under FDL licence