10. marts 2016 - 17:34Der er
11 kommentarer og 1 løsning
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"
Hej
Jeg har testet et regn ark på ovenstående det ville kun køre på min win 7, Excel 2007"
Den laver fejl : UserForm1.Calendar1.Day = Day(Now)
Jeg ville høre om der var en der kunne hjælpe med at få denne makro, til at køre på en win XP maskine som er min arbejdes computer lige nu Jeg bruger Excel 2007,
Det er vigtigt at den også kan køre på win 7, Excel 2007
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)
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
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.