Calendario access

**borgodiavalon** · 30-12-2008, 17:10

prova ora .

fammi sapere.

mi sarebbe piaciuto poter vedere come hai svolto il lavoro

apri il database, tasto desto--> visual basic editor

per le cose di cui avevi bisogno era necessario vba, dagli un occhio con l'aiuto della guida in linea.

ciao

**skanky** · 30-12-2008, 19:40

caro borgodiavalon, sei un mostro di bravura, hai perfettamente centrato il problema e risolto in modo perfetto.spero di non avere più bisogno del tuo aiuto perchè non vorrei sembrare pesante, ma se dovesse capitare di nuovo dimmi come contattarti. ciao e ancora grazie un mondo di auguri per un 2009 ricco di buone sorprese

**borgodiavalon** · 30-12-2008, 20:22

sei un mostro di bravura, hai perfettamente centrato il problema e risolto in modo perfetto.spero

a parte gli scherzi sono contento di esserti stato di aiuto.

dimmi come contattarti

sempre qui nel forum io o altri utenti (molto più bravi di me) siemo sempre pronti ad aiutare.

ciao

**borgodiavalon** · 31-12-2008, 09:08

nella finestra che ti si apre, quella in cui premi debug, dovrebbe esserci un codice che identifica l'errore, me lo scrivi?

edit: il campo data e quello del numero sedute sono necessarie per eseguire il codice vba, non vorrei sia la non compilazione di uno di quei due campi a bloccarti il tutto.

prova a sostituire quel codice con questo:

codice:

Private Sub Comando13_Click()
Dim MyData As Long
Dim MyCont  As String
Dim DBCorrente As Database
Set DBCorrente = CurrentDb

If IsNull(Me!NrSedute) Or IsNull(Me!Data) Then
    MsgBox "campo nr sedute e data prima seduta obbligatori" & Chr(13) & "verifica che siano stati compilati"
Else
    Application.SetOption "Confirm Action Queries", False
    MyCont = Forms!m_inser_multiplo!NrSedute

    MyData = Forms!m_inser_multiplo!Data

    For i = 1 To MyCont
          DoCmd.RunSQL ("INSERT INTO Appuntamenti (ID,  NrSedute, Data, Ora, Appuntamento, [Note] ) " & _
                                            "SELECT Forms!Privato!ID AS Espr6,  Forms!m_inser_multiplo!NrSedute AS Espr1, " & MyData & "  AS Espr2, Forms!m_inser_multiplo!Ora AS Espr3, Forms!m_inser_multiplo!Appuntamento AS Espr4, Forms!m_inser_multiplo!Note AS Espr5")
 
            MyData = MyData + 1
    Next
    Application.SetOption "Confirm Action Queries", True
    DoCmd.Close acForm, "m_inser_multiplo", acSavePrompt
    Forms!Privato![appuntamenti sottomaschera].Form.Requery
End If
End Sub

fammi sapere

ps: non ti ho risposto in privato in quanto se qualche altro utente avesse bisogno di aiuto su un caso simile non avrebbe trovato una risposta completa in questo 3d

**skanky** · 31-12-2008, 15:13

caro borgodiavalon, il messaggio che spunta è questo
impossibile accodare tutti i record nella query di accomodamento numero di campi impostati a Null per un errore di conversione tra tipi:0; numero di record non aggiunti alla tabella a causa di violazioni di chiave:1; a causa di violazione di condivisione;0; a causa di violazioni della regola di convalida:0
Continuare comunque l'esecuzione della query di comado?
scegliere si per ignorare l'errore o gli errori ed eseguire la query.
per una descrizione delle cause delle violazioni consultare la guida in linea
e li parte la finestra con i vari tipi di query di accomadamento.schiacciando il pulsante di debug sunta:errore di run-time "3059":
ho provato a copiare e incollare il codice che mi hai scritto tu su vba, ma non si muove foglia, rimane nella maschera di immisione dati.la cosa strana è che, prima di chiederti aiuto a volte registra qualche appuntamento, poi si blocca facendomi leggere quello che ti ho scritto sopra.forse sbaglio a digitare qualcosa, uso maiuscolo oppure digito male i caratteri della data?
scusami ma non volevo disturbarti così presto ciao

**borgodiavalon** · 06-01-2009, 18:02

l'errore credo ti appaia quando inserisci un nuovo paziente, infatti la scritta che ti appare indica una violazione della chiave primaria, ovvero tenti di inserire dei record su una tabella correlata senza che ci sia un record principale. per ovviare al problema apri la maschera "privato" in visualizzazione struttura --> tasto desto sul pulsante "inserimento multiplo" --> proprietà --> ti si aprirà una maschera a schede --> evento --> su click --> sulla destra dovrebbe esserci un piccolo pulsantino con tre puntini, lo clicchi --> ti si apre l'editor di vba e dovresti vedere questo:

Private Sub Comando31_Click()
On Error GoTo Err_Comando31_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "m_inser_multiplo"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Comando31_Click:
Exit Sub

Err_Comando31_Click:
MsgBox Err.Description
Resume Exit_Comando31_Click

End Sub

ora aggiungi la scritta in rosso esattamente dove l'ho messa.

Private Sub Comando31_Click()
On Error GoTo Err_Comando31_Click
DoCmd.RunCommand acCmdSaveRecord
Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "m_inser_multiplo"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Comando31_Click:
Exit Sub

Err_Comando31_Click:
MsgBox Err.Description
Resume Exit_Comando31_Click

End Sub

fammi sapere se funziona.

ciao

**skanky** · 07-01-2009, 21:05

Caro borgodiavalon, la variazione che mi hai consigliato di effettuare è andata a buo fine, funziona benissimo, ma ti chiedo: visto che io (grazie a Dio) almeno il sabato e la domenica sono libero, è possibile non inserirli nel piano degli appuntamenti? es. un paz. inizia giovedi, seguendo i giorni lavorativi finisce mercoledi della settimana successiva, mentre adesso finirebbelunedi includendo sabato e domenica. che rompiscatole sono vero?!!!?! ciao e grazie sempre

**borgodiavalon** · 08-01-2009, 20:06

apri la maschera "m_inser_multiplo" in visualizzazione struttura --> tasto desto sul pulsante "esegui" --> proprietà --> ti si aprirà una maschera a schede --> evento --> su click --> sulla destra dovrebbe esserci un piccolo pulsantino con tre puntini, lo clicchi --> ti si apre l'editor di vba e dovresti vedere questo:

Private Sub Comando13_Click()
Dim MyData As Long
Dim MyCont As String
Dim DBCorrente As Database
Set DBCorrente = CurrentDb

Application.SetOption "Confirm Action Queries", False
MyCont = Forms!m_inser_multiplo!NrSedute

MyData = Forms!m_inser_multiplo!Data

For i = 1 To MyCont
'MsgBox MyData
DoCmd.RunSQL ("INSERT INTO Appuntamenti (ID, NrSedute, Data, Ora, Appuntamento, [Note] ) " & _
"SELECT Forms!Privato!ID AS Espr6, Forms!m_inser_multiplo!NrSedute AS Espr1, " & MyData & " AS Espr2, Forms!m_inser_multiplo!Ora AS Espr3, Forms!m_inser_multiplo!Appuntamento AS Espr4, Forms!m_inser_multiplo!Note AS Espr5")

MyData = MyData + 1
Next
Application.SetOption "Confirm Action Queries", True
DoCmd.Close acForm, "m_inser_multiplo", acSavePrompt
Forms!Privato![appuntamenti sottomaschera].Form.Requery
End Sub

seleziona tutto--> cancella e inserisci questo codice:

codice:

Dim myDate As Date
Dim MyData As Long
Dim MyCont  As String
Dim DBCorrente As Database
Dim i

Private Sub Comando13_Click()
Set DBCorrente = CurrentDb

If IsNull(Me!NrSedute) Or IsNull(Me!Data) Then
    MsgBox "campo nr sedute e data prima seduta obbligatori" & Chr(13) & "verifica che siano stati compilati"
Else
    Application.SetOption "Confirm Action Queries", False '-->ELIMINA IL MESSAGGIO PREDEFINITO DI ACCESS PER LA CONFERMA DELLE AZIONI TRAMITE COMANDI SQL
    
    MyCont = Forms!m_inser_multiplo!NrSedute '-->IMPONE ALLA VARIABILE MyCont IL VALORE NECESSARIO PER ESEGUIRE IL CICLO

    MyData = Forms!m_inser_multiplo!Data '-->IMPONE ALLA VARIABILE MyData IL VALORE

    'INIZIO CICLO PER INSERIMENTO DEGLI APPUNTAMENTI
    For i = 1 To MyCont
            myDate = year(MyData) & "/" & Month(MyData) & "/" & Day(MyData) '-->IMPONE ALLA VARIABILE MyDate IL VALORE
        
            Festivo '--> FA PARTIRE LA FUNZIONE FESTIVO PER LA VERIFICA DEI GIORNI
         
            MyData = MyData + 1 '-->AUMENTA IL VALORE DELLA DATA DI UN GIORNO
            
    Next
    Application.SetOption "Confirm Action Queries", True '-->RIPRISTINA IL MESSAGGIO PREDEFINITO DI ACCESS PER LA CONFERMA DELLE AZIONI TRAMITE COMANDI SQL
    DoCmd.Close acForm, "m_inser_multiplo", acSavePrompt '-->CHIUDE MASCHERA
    Forms!Privato![appuntamenti sottomaschera].Form.Requery '-->ESEGUE REQUERY SULLA SOTTOMASCHERA
End If
End Sub

' VERIFICA SE LA DATA E' UN GIORNO FESTIVO IN ITALIA
Public Function Festivo()
    Dim FESTA As String
    
    If Weekday(myDate) = 7 Then '-->VERIFICA SE IL GIORNO CADE DI SABATO
            FESTA = "SABATO"
            GoTo MESSAGGIO
            
    ElseIf Weekday(myDate) = 1 Then '-->VERIFICA SE IL GIORNO CADE DI DOMENICA
            FESTA = "DOMENICA"
            GoTo MESSAGGIO
            
    Else '-->NEL CASO SIA GIORNO FERIALE

        Select Case myDate '-->VERIFICA LA DATA PER VEDERE SE APPARTIENE A QUALCHE FESTIVITA'
        
        '1. GENNAIO NUOVO ANNO
            Case DateSerial(year(myDate), 1, 1)
                FESTA = "1° DELL'ANNO"
                GoTo MESSAGGIO
          
        '6.GENNAIO - EPIFANIA
            Case DateSerial(year(myDate), 1, 6)
                FESTA = "EPIFANIA"
                GoTo MESSAGGIO
          
        '25 Aprile
            Case DateSerial(year(myDate), 4, 25)
                FESTA = "25 APRILE"
                GoTo MESSAGGIO
          
        '1. MAGGIO FESTA LAVORATORI
            Case DateSerial(year(myDate), 5, 1)
                FESTA = "1° MAGGIO (FESTA DEI LAVORATORI)"
                GoTo MESSAGGIO
          
        '2. GIUGNO FESTA DELLA REPUBBLICA
            Case DateSerial(year(myDate), 6, 2)
                FESTA = "2 GIUGNO (FESTA DELLA REPUBBLICA)"
                GoTo MESSAGGIO
          
        'PASQUA
            Case Easter(year(myDate))
                FESTA = "PASQUA"
                GoTo MESSAGGIO
          
        'LUNEDI DI PASQUA
            Case Easter(year(myDate)) + 1
                FESTA = "LUNEDI' DELL'ANGELO"
                GoTo MESSAGGIO
          
        '15. AGOSTO
            Case DateSerial(year(myDate), 8, 15)
                FESTA = "FERRAGOSTO"
                GoTo MESSAGGIO
                      
        '1. NOVEMBRE - TUTTI I SANTI
            Case DateSerial(year(myDate), 11, 1)
                FESTA = "TUTTI I SANTI"
                GoTo MESSAGGIO
          
        '8. DICEMBRE - IMMACOLATA CONCEZIONE
            Case DateSerial(year(myDate), 12, 8)
                FESTA = "IMMACOLATA CONCEZIONE"
                GoTo MESSAGGIO
          
        '9. DICEMBRE - S. AMBROGIO
        'QUESTA FESTA E' PRESENTE A MILANO, PER INSERIRE QUELLA DI DOVE ABITI O LAVORI BASTA MODIFICARE IL 12 (MESE) ED IL 9 (GIORNO) CON QUELLI CORRETTI PER TE
            Case DateSerial(year(myDate), 12, 9)
                FESTA = "S. AMBROGIO (PATRONO DI MILANO)"
                GoTo MESSAGGIO
          
        '25. DICEMBRE - NATALE
            Case DateSerial(year(myDate), 12, 25)
                FESTA = "NATALE"
                GoTo MESSAGGIO
          
        '26. DICEMBRE - SANTO STEFANO
            Case DateSerial(year(myDate), 12, 26)
                FESTA = "S. STEFANO"
                GoTo MESSAGGIO
          
      Case Else '--> SE NON E' FESTIVO INSERISCE L'APPUNTAMENTO
            DoCmd.RunSQL ("INSERT INTO Appuntamenti (ID,  NrSedute, Data, Ora, Appuntamento, [Note] ) " & _
                                            "SELECT Forms!Privato!ID AS Espr6,  Forms!m_inser_multiplo!NrSedute AS Espr1, " & MyData & "  AS Espr2, Forms!m_inser_multiplo!Ora AS Espr3, Forms!m_inser_multiplo!Appuntamento AS Espr4, Forms!m_inser_multiplo!Note AS Espr5")
            
      End Select
    End If
   
Exit Function

MESSAGGIO:
    'CHIEDE SE NONOSTANTE IL GIORNO SIA FESTIVO SI VUOLE INSERIRE L'APPUNTAMENTO
    Select Case MsgBox("ATTENZIONE LA DATA INSERITA RISULTA CORRISPONDERE ALLA SEGUENTE FESTIVITA':" & Chr(13) & FESTA & Chr(13) & "VUOI INSERIRLA UGUALMENTE?", vbYesNo)
        Case Is = vbYes '-->SE SI INSERISCE L'APPUNTAMENTO
            DoCmd.RunSQL ("INSERT INTO Appuntamenti (ID,  NrSedute, Data, Ora, Appuntamento, [Note] ) " & _
                                            "SELECT Forms!Privato!ID AS Espr6,  Forms!m_inser_multiplo!NrSedute AS Espr1, " & MyData & "  AS Espr2, Forms!m_inser_multiplo!Ora AS Espr3, Forms!m_inser_multiplo!Appuntamento AS Espr4, Forms!m_inser_multiplo!Note AS Espr5")
        Case Is = vbNo '-->SE NO RIDUCE DI UNO IL CONTATORE DEL CICLO
            i = i - 1
    End Select
End Function

' CALCOLO DELLA PASQUA
' Questa funzione non è mia ma è recuperata dal WEB
Function Easter(year As Integer) As Date
   Dim d As Integer
   d = (((255 - 11 * (year Mod 19)) - 21) Mod 30) + 21
   Easter = DateSerial(year, 3, 1) + d + (d > 48) + 6 - _
   ((year + year \ 4 + d + (d > 48) + 1) Mod 7)
End Function

la funzione 'festivo' e 'calcolo della pasqua' non sono mie ma le trovo molto buone, ho pensato di inserirle così che il problema che hai posto sia risolto anche per altri giorni di festività.

fammi sapere se funziona tutto.

**skanky** · 08-01-2009, 21:54

Mio caro, cosa devo rispondere....? sono ancora a bocca aperta, tutto perfetto, funziona a meraviglia e sono molto contento di avere avuto a che fare con te e la tua preparazione; sono anche contento che tanti altri si sono interessati al problema visto il grande numero di collegamenti e spero che anche loro siano rimasti soddisfatti e perchè no abbiano risolto qualche loro dubbio. ancora grazie e .... al prossimo problema ciaooooo

**borgodiavalon** · 08-01-2009, 23:34

contento che tu abbia risolto

alla prossima

ps: sono solo un buon (spero) dilettante.

Discussione: Calendario access

Strumenti discussione

Ricerca discussione

Visualizza

calendario access

calendario access

calendario access

calendario access

Permessi di invio