Makro som ikke ville køre på "Win XP, Excel 2007", "Win 8 Microsoft Office Home & Student 2013" Eller på "Win 8, Office Home and Student 2010"

Denne link skulle dur

http://play48.com/gratisupload/userprofiles/gD408TS8wH/K%F8rselsrapport%5F29%5F02%5F2016%5F1%2Exlsm

Hej Martin

Problemet er sikkert at "Calendar" ikke findes på din XP.
Jeg har for meget længe siden konstrueret en kalender, der måske kan anvendes.

Vender tilbage hvis jeg finder den.

Hej supertekst

Oki det lyder spændende  , jeg troede det var noget standard kode , går koden ikke ind og læser i windows kalenderen ?

Alt denne kode bliver jeg også nød til at "rem" før den ville bare køre lidt på min XP,  og de andre ovenstående  vasioner også -

‘VERSION 1.0 CLASS
‘BEGIN
‘  MultiUse = -1  'True
‘END
‘Attribute VB_Name = "ThisWorkbook"
‘Attribute VB_GlobalNameSpace = False
‘Attribute VB_Creatable = False
‘Attribute VB_PredeclaredId = True
‘Attribute VB_Exposed = True

Hilsen Martin

Har ikke kunnet finde den selvkonstruerede kalender.

Prøv evt. følgende:
Evt. kalender findes således:
Alt+F11 (VBA-vinduet)
- Menu: Tools
-- Additional Controls
--- Kalender eller DateTimePicker kontrolelement

Hej igen

Øv,  jeg tænker hvorfor kunne den ikke køre på en nyer win og excel vasione

Jeg har prøvet at trykke på Menu den ville ikke på nogen af de maskiner ?

Jeg har lavet prt scr fra min win XP maskine

http://play48.com/gratisupload/userprofiles/ffFss1ud5L/Prt%20Scr%2Ejpg

Hej Martin

Er ved at konstruere en kalender til dig, der også kan anvendes på XP

Så er der en ny version.
Userform kan nu også aktiveres ved at dobbeltklikke på celler i A1

Hvis du sender en mail - så returnerer jeg filen med den nye version af kalender. @-adresse under min profil

Uah det lyder spændende,  du få her min E-mail

mbg0574@gmail.com kunne den mon også køre på win 8 mmon?

hvad skulle der laves om mon?

Hilsen Martin

Har du modtaget min mail med den nye version?

VBA-kode i Userform som erstatning for "Calendar"
Dim dag As String, dato As Date, ugeNr As Integer, år As Integer
Dim tabel As Variant, dagsnr As Integer
Const ugeDage = "Mandag,Tirsdag,Onsdag,Torsdag,Fredag,Lørdag,Søndag"
Const måneder = "Januar,Februar,Marts,April,Maj,Juni,Juli,August,September,Oktober,November,December"

Dim flag As Boolean
Function beregnUgeNr(dato)
Dim Resten As Single
    Resten = (dato - 2) Mod 7
    beregnUgeNr = Int((dato - DateSerial(Year(dato + 3 - Resten), 1, Resten - 9)) / 7)
End Function
Private Sub Cb_Idag_Click()
    Me.Com_Dag.ListIndex = Day(Now) - 1
    Me.Com_Måned.ListIndex = Month(Now) - 1
    Me.Com_År = Year(Now)
   
    flag = True
    datoSkift
End Sub
Private Sub cb_Ok_Click()
    dato = Me.Com_Dag & "-" & Me.Com_Måned.ListIndex + 1 & "-" & Me.Com_År
    Range("C3") = tabel(hentDagensNr(dato) - 1)
    Range("D3") = Format(dato, "mm-dd")
    Range("E3") = Me.Tb_ugeNr
    Range("F3") = Me.Com_År
   
    Unload Me
   
    ThisWorkbook.findNyRække
End Sub
Private Sub Com_Dag_Change()
    If flag = True Then
        datoSkift
    End If
End Sub
Private Sub Com_Måned_Change()
    If flag = True Then
       
        datoSkift
    End If
End Sub
Private Sub Com_År_Change()
    If flag = True Then
        datoSkift
    End If
End Sub
Private Sub datoSkift()
Dim nyDato As Date, d As Integer, sidsteDag As Integer
    antalDage = hentAntalDageMåned(Me.Com_År, Me.Com_Måned.ListIndex)
   
    nyDato = Me.Com_Dag & "-" & Me.Com_Måned.ListIndex + 1 & "-" & Me.Com_År

    sidsteDag = Me.Com_Dag.ListCount
    If sidsteDag > antalDage Then
        While Me.Com_Dag.ListCount > antalDage
            Me.Com_Dag.RemoveItem (Me.Com_Dag.ListCount) - 1
        Wend
    Else
        If sidsteDag < antalDage Then
            While Me.Com_Dag.ListCount < antalDage
                sidsteDag = sidsteDag + 1
                Me.Com_Dag.AddItem sidsteDag
            Wend
        End If
    End If
   
    Me.Tb_ugeNr = beregnUgeNr(nyDato)
End Sub
Private Sub UserForm_Activate()
Dim i As Integer, antalDage As Integer
Rem Dette år + næste
    Me.Com_År.AddItem Year(Now) - 1
    Me.Com_År.AddItem Year(Now)
    Me.Com_År.AddItem Year(Now) + 1
    Me.Com_År.ListIndex = 1
   
Rem Måneder
    tabel = Split(måneder, ",")
    For i = 0 To UBound(tabel)
        Me.Com_Måned.AddItem tabel(i)
    Next i
    Me.Com_Måned.ListIndex = Month(Now) - 1
   
Rem Dage
    antalDage = hentAntalDageMåned(Year(Now), Month(Now) - 1)
    For i = 1 To antalDage
        Me.Com_Dag.AddItem i
    Next i
    Me.Com_Dag.ListIndex = Day(Now) - 1
   
Rem BeregnUgeNr
    ugeNr = beregnUgeNr(Now)
    Me.Tb_ugeNr = ugeNr
   
    tabel = Split(ugeDage, ",")
   
    flag = True
End Sub
Private Sub UserForm_Terminate()
    ThisWorkbook.findNyRække
End Sub
Private Function hentAntalDageMåned(år, md)
Const normDage = "31,28,31,30,31,30,31,31,30,31,30,31"
Dim mdDage As Variant
Dim xÅr As Integer, xMd As Integer, xMdDage As Byte
    mdDage = Split(normDage, ",")

    xÅr = år
    xMd = md
   
    If xMd + 1 = 2 Then
        If xÅr Mod 4 = 0 Then
            xMdDage = 29
        Else
            xMdDage = 28
        End If
    Else
        xMdDage = mdDage(xMd)
    End If

    hentAntalDageMåned = xMdDage
End Function
Public Function hentDagensNr(dato As Date)
    hentDagensNr = Weekday(dato, vbMonday)
End Function
Private Function hentDagensNavn(dagsnr As Byte)
    hentDagensNavn = dgNavn(dagsnr)
End Function
Public Function hentMånedsNavn(mdnr As Byte)
    hentMånedsNavn = mdLangtnavn(mdnr)
End Function

Håber du har fået dine point?

: -)