Buongiorno ho un file Excel condiviso tra diversi pc della mia ditta ma su uno di questi è installato libreoffice calc e non riesco a far funzionare la pagina iniziale dove è presente un calendario dove cliccando sul giorno 1 si apre il foglio 1 ecc. ecc…Calendar.xlsx
Sub GeneraCalendario()
’ aggiunge la Pasqua
Dim sh As Worksheet
Sheets(“Foglio2”).Unprotect Password:=“leo2018”
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets(“Foglio2”)
sh.Range(“G13”).FormulaLocal = “=ARROTONDA.DIFETTO(DATA(CALENDARIO!$E$2;5;GIORNO(MINUTO(CALENDARIO!$E$2/38)/2+56));7)-34”
sh.Range(“G2:G14”).Copy
sh.Range(“D2:D14”).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(“Foglio2”).Activate
Range(“A1”).Select
Sheets(“Calendario”).Activate
Sheets(“Foglio2”).Protect Password:=“leo2018”
Application.ScreenUpdating = True
'------------------------------------------------------------------------------------------------------
Dim Mese As Integer, Anno As Integer
Dim C As Integer, r As Integer
Dim j As Integer, k As Integer
Dim ultimogg As Integer
Dim primariga As Integer
Dim ultimariga As Integer
Dim primacolonna As Integer
Dim ultimacolonna As Integer
primariga = 5
ultimariga = 10
primacolonna = 8
ultimacolonna = 14
Mese = ActiveSheet.Cells(2, 3)
Anno = ActiveSheet.Cells(2, 5)
ultimogg = Day(DateSerial(Anno, Mese + 1, 1) - 1)
Range(Cells(primariga, primacolonna), Cells(ultimariga, ultimacolonna)).Value = “”
’ il valore seguente (c) la data (anno,mese,1), il primo giorno della settimana (vbMonday)
’ che inizia con 1 = domenica, 2 = lunedÒ ecc.) quindi nel nostro caso 2 + 6
’ il sei si aggiunge per far iniziare dalla colonna che si desidera nel nostro caso 8
C = Weekday(DateSerial(Anno, Mese, 1), vbMonday) + 7
r = primariga
Cells(r, C) = DateSerial(Anno, Mese, 1)
C = C + 1
For j = r To ultimariga
For k = C To ultimacolonna
If k = C And j > r Then
Cells(j, k) = Cells(j - 1, ultimacolonna) + 1
Else
Cells(j, k) = Cells(j, k - 1) + 1
End If
If Day(Cells(j, k)) = ultimogg Then
GoTo esci
End If
Next
C = primacolonna
Next
esci:
Set sh = Nothing
Application.ScreenUpdating = True
End Sub
questo è il codice inserito nel modulo 1 mentre il seguente è nel foglio Calendario
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim b As String
If Not Intersect(Target, Range("H5:N10")) Is Nothing Then
a = Day(Target)
b = a
Sheets(b).Visible = True
Sheets(b).Activate
Cancel = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aa As String
If Not Intersect(Target, Range("E2")) Is Nothing Then
Range("E2").Select
End If
End Sub
enter code here