Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια! |
| Εργαλεία Θεμάτων | Τρόποι εμφάνισης |
#1
| ||||
| ||||
Διόρθωση-αλλαγή σε κώδικα ρουτίνας
Καλησπέρα σε όλους τους φίλους του Forum!! Γνωρίζει κάποιο μέλος στον παρακάτω κώδικα τι διόρθωση ή τι κώδικα πρέπει να βάλω ώστε να εμφανίζω το αποτέλεσμα χωρίς δεδομένα από πίνακα που εμφανίζει η παρακάτω ρουτίνα.θέλω να αποφύγω τον πίνακα και την χειροκίνητη ενημέρωση. Το ζητούμενο είναι : 1) ότι κάθε 1 και 15 του μήνα να μου ανοίγει η ιστοσελίδα που περιέχει η ρουτίνα. 2) Εάν η ημερομηνία πέφτει Σάββατο η ενημέρωση να γίνεται δύο μέρες μετά εάν πέφτει Κυριακή να γίνεται μία μέρα μετά. 3) Τον Ιούλιο και Αύγουστο να μην ενημερώνει. Κώδικας: Option Compare Database Option Explicit 'Ρουτίνες που ενεργοποιούνται με την έναρξη της εφαρμογής Private Const CnstNameTable As String = "TblSurveyDays" Public Sub sShowSurveyDays() 'Ρουτίνα που εμφανίζει το σύστημα καταγραφής Dim ie As Object 'Dim ie As InternetExplorer Dim CurrentSysDate As Date, CurrentSysMonth, CurrentSysDay As Integer Dim i As Integer, TmpName As String CurrentSysDate = Date CurrentSysMonth = Month(CurrentSysDate) CurrentSysDay = Day(CurrentSysDate) i = 0 Dim RcdNames As New ADODB.Recordset RcdNames.Open "Select * From " & CnstNameTable & " Where Day=" & CurrentSysDay _ & " and Month=" & CurrentSysMonth, CurrentProject.Connection, adOpenDynamic If Not RcdNames.EOF And Not RcdNames.BOF Then RcdNames.MoveFirst Do While Not RcdNames.EOF i = i + 1 If i > 1 Then TmpName = TmpName & " , " & RcdNames.Fields("SurveyDay") Else TmpName = RcdNames.Fields("SurveyDay") End If RcdNames.MoveNext Loop Dim Response As Integer If i > 1 Then Else Response = MsgBox("ΚΑΛΗΜΕΡΑ ΣΗΜΕΡΑ ΠΡΕΠΕΙ ΝΑ ΕΝΗΜΕΡΩΣΕΤΕ ΤΟ : " & TmpName _ & vbNewLine & "ΣΥΝΔΕΘΕΙΤΕ ΣΤΟ ΙΝΤΕΡΝΕΤ. ", vbYesNo + vbDefaultButton1, " ΕΝΗΜΕΡΩΣΗ ΤΟΥ SURVEY ") End If If Response = vbYes Then Set ie = CreateObject("InternetExplorer.Application") ie.Navigate2 "http://survey.sch.gr/" ie.Visible = True ' While ie.ReadyState <> 4 DoEvents Wend Set ie = Nothing End If End If RcdNames.Close End Sub
__________________ Με εκτίμηση Αλέξανδρος Τελευταία επεξεργασία από το χρήστη alex : 24-09-13 στις 05:04. |
#2
| ||||
| ||||
Καλημέρα και πάλι σε όλουs τους φίλους του forum!!! Έχω προσθέσει κάποιο κώδικα στην ρουτίνα BasExecSurveyDays που επισυνάπτω για να βελτιώσω την βοήθεια στον κώδικα. Εάν γνωρίζει κάποιο μέλος τι πρέπει να κάνω και πώς πρέπει να συντάξω κώδικα συμφωνα με τις αργίες που εμφανίζω στη παρακάτω επισυναπτόμενη βάση.
__________________ Με εκτίμηση Αλέξανδρος |
#3
| ||||
| ||||
Καλησπέρα Δοκίμασε τον κώδικα και αν δουλέψει να τον χρησιμοποιήσω και εγώ! Κώδικας: Private Sub btn_start_Click() If Month(Date) = 7 Or Month(Date) = 8 Then Exit Sub 'Διώχνεις Ιούλιο-Αύγουστο Dim x As Integer x = 1 Select Case DatePart("w", Date) Case Is = 1 'Κυριακή x = x + 1 Case Is = 7 'Σάββατο x = x + 2 End Select If Day(Date) = x Or Day(Date) = 14 + x Then Dim strUrl$ strUrl = "http://survey.sch.gr/" Call Shell("explorer.exe " & strUrl, 5) End If End Sub Με εκτίμηση Νίκος Δ. |
#4
| ||||
| ||||
Ευχαριστώ Νίκο!!!! Θα κάνω κάποιες δοκιμές αν μπορέσω να κάνω κάτι.Με πίνακα το έχω και δουλεύει αλλά πρέπει να κοιτάξω το ημερολόγιο για τα επόμενα 5 χρόνια και να βάλω τις ημερομηνίες που πρέπει να ενημερώνουμε. Η λογική μου είναι ότι αν γίνει με κώδικα module δεν χρειάζεται ούτε πίνακας τίποτα. Θα το έβαζα σε ένα setup και με την εγκατάσταση θα το έβαζα στο start up με το άνοιγμα του υπολογιστή θα με ειδοποιούσε να ξεφύγουμε από αυτή την γάγγραινα. Στο συνημμένο που ανεβάζω δουλεύει μέχρι 31/12/2003. Απλά έβαλα την σημερινή ημερομηνία για να σου ανοίξει.Γιατί μετά τις 12 δεν θα ανοίγει ο Internet explorer.
__________________ Με εκτίμηση Αλέξανδρος |
#5
| ||||
| ||||
Νίκο καλησπέρα!!! Έχω κάνει κάποιες αλλαγές .Θέλει δοκιμές και να γυρίζω την ημερομηνία του υπολογιστή η κάθε 1η ή κάθε 15η.Προσπαθούμε!!! Βγάζει μήνυμα Type Mismatch στη θέση If Month(Date) = 7 Or Month(Date) = 8 Then Exit Sub *''Διώχνεις Ιούλιο και Αύγουστο * ** Κώδικας: Public Sub sShowSurveyDays() 'Η ρουτίνα που εμφανίζει το σύστημα καταγραφής των στοιχείων Dim ie As Object Dim Month As Variant Dim TmpName As String 'Εδώ χτυπάει If Month(Date) = 7 Or Month(Date) = 8 Then Exit Sub 'Διώχνεις Ιούλιο και Αύγουστο Dim x As Integer x = 1 Select Case DatePart("w", Date) Case Is = 1 'Κυριακή x = x + 1 Case Is = 7 'Σάββατο x = x + 2 End Select If Day(Date) = x Or Day(Date) = 14 + x Then Dim Response As Integer Response = MsgBox("ΚΑΛΗΜΕΡΑ ΣΗΜΕΡΑ ΠΡΕΠΕΙ ΝΑ ΕΝΗΜΕΡΩΣΕΤΕ ΤΟ : " & TmpName _ & vbNewLine &"ΣΥΝΔΕΘΕΙΤΕ ΣΤΟ ΙΝΤΕΡΝΕΤ. ", vbYesNo + vbDefaultButton1, " ΕΝΗΜΕΡΩΣΗ ΤΟΥ SURVEY ") If Response = vbYes Then Set ie = CreateObject("InternetExplorer.Application") ie.Navigate2 "http://survey.sch.gr/" ie.Visible = True End If End If End Sub
__________________ Με εκτίμηση Αλέξανδρος Τελευταία επεξεργασία από το χρήστη alex : 24-09-13 στις 23:41. |
#6
| ||||
| ||||
Καλημέρα Χτυπάει γιατί η έκφραση Month(ημερονία) είναι συνάρτηση που επιστρέφει τον μήνα της ημερομηνίας του ορίσματος και εσύ όρισες τη λέξη Month ως μεταβλητή! Διέγραψε το : Dim Month As Variant Για δες το... με εκτίμηση, Νίκος Δ. |
#7
| ||||
| ||||
Καλημέρα Νίκο!! Σωστά το διόρθωσα δεν κτυπάει αλλά δεν δουλεύει.Πρέπει να περπατήσω το κώδικα γραμμή γραμμή κάπου πρέπει να πηδάει σειρές.
__________________ Με εκτίμηση Αλέξανδρος |
#8
| ||||
| ||||
Νίκο συγνώμη είχα ανεβάσει λάθος συνημμένο!!! οπότε το άλλαξα Δές το συνημμένο μια διαφορετική προσέγγιση.Δεν το έχω δοκιμάσει Για να λειτουργεί όλο το πακέτο του Module να βρίσκει το έτος το ανάλογο πάσχα τα ΣΚ off μέχρι εκεί δουλεύει Η αλλαγή στο κώδικα που έκανα . Θέλει συμπλήρωμα κώδικα που να λέει εάν συμπίπτουν οι ημερομηνίες 1 και 15 κάθε μήνα με τα weekends να μεταφέρονται οι ημερομηνίες από το Σάββατο +2 και την Κυριακή +1 και να εμφανίζει το παρακάτω μήνυμα με πράσινο από εκεί και κάτω πάλι δουλεύει. Κώδικας: Public Sub sShowSurveyDays() 'Η ρουτίνα που εμφανίζει το σύστημα καταγραφής των στοιχείων Dim ie As Object Dim TmpName As String Dim StartDate As Date Dim NettoAbsenceDays As Integer Dim LastAbsenceDate As Date Dim i As Integer, xDate As Date Dim EndDate As Date For xDate = StartDate To EndDate If Weekday(xDate, vbMonday) < 5 Then If Not IsHoliday(xDate) Then CountOfWDays = CountOfWDays + 1 Else HolidaysCount = HolidaysCount + 1 End If End If Next Dim Response As Integer ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'χχχχχχχχχχχχχχχχχχχχχχχχχχχχχχχ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Response = MsgBox("ΚΑΛΗΜΕΡΑ ΣΗΜΕΡΑ ΠΡΕΠΕΙ ΝΑ ΕΝΗΜΕΡΩΣΕΤΕ ΤΟ : " & TmpName _ & vbNewLine &"ΣΥΝΔΕΘΕΙΤΕ ΣΤΟ ΙΝΤΕΡΝΕΤ. ", vbYesNo + vbDefaultButton1, " ΕΝΗΜΕΡΩΣΗ ΤΟΥ SURVEY ") If Response = vbYes Then Set ie = CreateObject("InternetExplorer.Application") ie.Navigate2 "http://survey.sch.gr/" ie.Visible = True End If End Sub
__________________ Με εκτίμηση Αλέξανδρος Τελευταία επεξεργασία από το χρήστη alex : 25-09-13 στις 08:36. |
#9
| ||||
| ||||
Καλησπέρα Δεν συμφωνώ με την επιλογή σου να ψάχνεις τις μη εργάσιμες ημέρες για το θέμα που συζητάμε. Παράδειγμα: Είναι Παρασκευή 1-xx-2013 και εσύ ο χειριστής απουσιάζεις. Αυτό σημαίνει ότι ...τη Δευτέρα "το πουλάκι πέταξε"! Άρα πάει στράφι όλη η δουλειά σου για να οργανώσεις πίνακες με Πάσχα, Χριστούγεννα, κλπ. Έχω κάτι "θολό" στον νου μου αλλά δεν μπορώ να το δώ πριν το Σαββατοκύριακο. Προς το παρόν -ενσωμάτωσα σε μικροεφαρμογές που χρησιμοποιώ στο σχολείο, τον κώδικα του επισυναπτόμενου. Ειλικρινά δεν μπόρεσα να δοκιμάσω το δικό σου λόγω χρόνου. Μόλις έχω κάνει σχετικό με αυτό που σκέπτομαι, θα τα ξαναπούμε Με εκτίμηση Νίκος Δ. |
#10
| ||||
| ||||
Καλημέρα στη παρέα!!!! Καλημέρα Νίκο!! Συγνώμη από το Διαχειριστή για κάποιες διορθώσεις. Τελικά έκανα μετά από μεγάλο κόπο έστω προσωρινά Manual όλα αυτά που χρειάζονται για την ενημέρωση του Survey.Επόμενο βήμα προγραμματιστικά. Τί κάνει το πρόγραμμα: 1) Κάθε 1 και 15 του μήνα ανοίγει η ιστοσελίδα που περιέχει η ρουτίνα. 2) Εάν η ημερομηνία πέφτει Σάββατο η ενημέρωση να γίνεται δύο μέρες μετά εάν πέφτει Κυριακή γίνεται μία μέρα μετά. 3)Εάν είναι περίοδος Χριστουγέννων ενημερώνει με τη έναρξη του πρώτου μαθήματος Εάν είναι Πάσχα σύμφωνα με το Πατριαρχείο κάθε χρόνο μεταβαλλόμενες ημερομηνίες με την αμέσως επόμενη εργάσιμη ημέρα 4) Τον Ιούλιο και Αύγουστο να μην ενημερώνει. Υ/Γ Ενημέρωση κάνει μέχρι το 2030
__________________ Με εκτίμηση Αλέξανδρος |
« Προηγούμενο Θέμα
|
Επόμενο Θέμα »
| |
Παρόμοια Θέματα | ||||
Θέμα | Δημιουργός | Forum | Απαντήσεις | Τελευταίο Μήνυμα |
[Συναρτήσεις] Αλλαγη ημερομηνία έπειτα απο αλλαγή | xaralampos | Excel - Ερωτήσεις / Απαντήσεις | 1 | 24-06-16 21:45 |
Διόρθωση ρουτίνας | alex | Access - Ερωτήσεις / Απαντήσεις | 6 | 09-01-13 15:07 |
Διόρθωση κώδικα σε Module | alex | Access - Ερωτήσεις / Απαντήσεις | 2 | 12-08-11 13:01 |
Διόρθωση κώδικα | alex | Access - Ερωτήσεις / Απαντήσεις | 2 | 13-06-11 08:14 |
[Γενικά] Διορθωση κωδικα | misirlis | Excel - Ερωτήσεις / Απαντήσεις | 2 | 13-01-11 07:30 |
Η ώρα είναι 03:04.