Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 03-03-10, 12:09
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή

Γιώργο καλημέρα!

Ο Macro Recorder είναι χρήσιμος αλλά από τη φύση του καταγράφει ακριβώς τις κινήσεις
του χρήστη και αυτό ακριβώς το πρόβλημα σε περιπτώσεις όπως τη δική σου.
Σχεδόν πάντα χρειάζεται ή επέμβαση του χρήστη προκειμένου να λειτουργήσει ο κώδικας
αποτελεσματικά μετά από μια καταγραφή μακροεντολής.
Για την εύρεση του αριθμού της ημερολογιακής εβδομάδας με VBA, χρησιμοποιούμε το εξής:
Κώδικας:
Function CurrWeekNum(d As Date) As Integer
    Dim xd#
    xd = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
    CurrWeekNum = (d - xd - 3 + (Weekday(xd) + 1) Mod 7) / 7 + 1
End Function
Για την προσθήκη φύλλου εργασίας όπως το ζήτησες μπορείς να χρησιμοποιήσεις
(αφού κάνεις τυχόν προσαρμογές) τον παρακάτω κώδικα:

Κώδικας:
Option Explicit

Sub CreateWorkSheetWithButton()
    Dim WeekNumber$, wks As Worksheet
    WeekNumber = "Week" & CurrWeekNum(Date)
    On Error Resume Next
    Set wks = ThisWorkbook.Worksheets(WeekNumber)
    If Not wks Is Nothing Then Exit Sub
    Err.Clear
    On Error GoTo 0
    With ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
        .Name = WeekNumber
        With .Buttons.Add(1, 1, 1, 1)
            .Name = "Btn1"
            .Caption = "My Button"
            .Top = Range("E2").Top
            .Left = Range("E2").Left
            .Width = Range("E2").Width
            .Height = Range("E2").Height
            .OnAction = ThisWorkbook.Name & "!MyMacroName"
            With .Characters(1, Len(.Caption)).Font
                .Name = "Arial"
                .FontStyle = "Standard"
                .Size = 10
                .ColorIndex = 3
            End With
        End With
    End With
End Sub

Function CurrWeekNum(d As Date) As Integer
    Dim xd#
    xd = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
    CurrWeekNum = (d - xd - 3 + (Weekday(xd) + 1) Mod 7) / 7 + 1
End Function
Φιλικά

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση