07. oktober 2007 - 14:55Der er
14 kommentarer og 1 løsning
Excel-makro virker kun på én fane
Jeg har for vores tipsklub lavet en makro i Excel, der henter resultater fra Danske Spils hjemmeside og derefter opdaterer stillingerne i turneringen.
Makroen aktiveres via en knap og gentager sig selv hvert minut.
Men makroen virker kun, så længe den er på den fane, hvor den er aktiveret og udfører ændringer. Hvis jeg er på en anden fane i excel-arket (f.eks. med regler), så stopper makroen med en fejlbeskrivelse i Visual Basic: "Run time error 1004. Application-defined or object-defined error". Klikker jeg debug her, kommer jeg frem til koden, hvor den markerer linjen "Selection.QueryTable.Refresh BackgroundQuery:=False".
Jeg søger hjælp til en stump kode, som jeg kan smide ind i starten af makroen, som får makroen til en af følgende:
1) Makroen bringer os tilbage på den oprindelige fane, inden den udfører resten.
2) Hvis vi er på en anden fane, udføres makroen i baggrunden uden at flyttes os.
...starter makroen rigtigt (det gjorde den ikke før), men jeg får nu følgende fejl (mens den bliver på den fane, jeg er på (altså ikke den, makroen kører på):
Run-time error '-2147024809 (80070057). The item with the specified name wasn't found". Debug bringer os nu til linjen 'ActiveSheet.Shapes("Button 11").Select'.
Kan det være fordi den bare kun kan udføre sig selv (makroen laver ret meget både i fanen og på nettet), hvis den ikke er på den fane, makroen kører på? Det er også fint nok, hvis den så bare ville bringe os tilbage til den fane, hver gang den startede.
Og det her kalder ovenstående makro hvert minut og afspiller donglyd ved mål...
Sub KaldTipsupdate() If ShouldStop = 1 Then End Tipsupdate If Range("AG108") = 1 Then Dong If ShouldStop = 1 Then End Application.OnTime Now + TimeValue("00:00:59"), "KaldTipsupdate" End Sub
Sub Dong() Dim WAVFile As String Const SND_ASYNC = &H1 Const SND_FILENAME = &H20000 WAVFile = "c:\windows\dong.wav" Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME) End Sub
Sub Tipsupdate() ' ' Tips13 Makro ' Makro indspillet 19-01-2003 af Bo Falsig ' With Worksheets("Tipsupdate") ' Application.ScreenUpdating = False ActiveWorkbook.RefreshAll ' opdaterer alle Queries, derfor skal den vel ikke kaldes igen længere nede .Range("AD2").FormulaR1C1 = "=R[76]C[-26]" .Range("AD2").AutoFill Destination:=Range("AD2:AD26"), Type:=xlFillDefault .Range("AD2").AutoFill Destination:=Range("AD2:AE2"), Type:=xlFillDefault .Range("AE2").AutoFill Destination:=Range("AE2:AE26"), Type:=xlFillDefault
With .Range("AD2:AE26") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With With .Range("AD14:AE14") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone End With
With .Range("AD26:AE26") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone End With With .Range("AE2:AE26")
.Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD4:AE4") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD7:AE7") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD10:AE10") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD17:AE17") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD20:AE20") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD23:AE23") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With .Range("D78:E90").Copy .Range("Y83:Z95").PasteSpecial xlValues .Range("D91:E102").Copy .Range("Y96:Z107").PasteSpecial xlValues ' .QueryTables(1).Refresh BackgroundQuery:=False' den er kaldt i toppen .Range("D78:E102").Copy .Range("AB83:AC107").PasteSpecial xlValues
With .Shapes("Button 11") With .Font .Name = "Arial" .FontStyle = "Regular" .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = 9 End With End With End With Application.ScreenUpdating = True End Sub
Sub KaldTipsupdate() If ShouldStop = 1 Then End Tipsupdate If Worksheets("Tipsupdate").Range("AG108") = 1 Then Dong
If ShouldStop = 1 Then End ' hvad er ShouldStop
Application.OnTime Now + TimeValue("00:00:59"), "KaldTipsupdate" End Sub
Sub Dong() Dim WAVFile As String Const SND_ASYNC = &H1 Const SND_FILENAME = &H20000 WAVFile = "c:\windows\dong.wav" Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME) End Sub
der var et par smuttere, de skulle være rettet her
Sub Tipsupdate() ' ' Tips13 Makro ' Makro indspillet 19-01-2003 af Bo Falsig ' With Worksheets("Tipsupdate") ' Application.ScreenUpdating = False ActiveWorkbook.RefreshAll ' opdaterer alle Queries, derfor skal den vel ikke kaldes igen længere nede .Range("AD2").FormulaR1C1 = "=R[76]C[-26]" .Range("AD2").AutoFill Destination:=.Range("AD2:AD26"), Type:=xlFillDefault .Range("AD2").AutoFill Destination:=.Range("AD2:AE2"), Type:=xlFillDefault .Range("AE2").AutoFill Destination:=.Range("AE2:AE26"), Type:=xlFillDefault
With .Range("AD2:AE26") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With With .Range("AD14:AE14") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone End With
With .Range("AD26:AE26") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone End With With .Range("AE2:AE26")
.Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD4:AE4") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD7:AE7") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD10:AE10") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With With .Range("AD17:AE17") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD20:AE20") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With
With .Range("AD23:AE23") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End With .Range("D78:E90").Copy .Range("Y83:Z95").PasteSpecial xlValues .Range("D91:E102").Copy .Range("Y96:Z107").PasteSpecial xlValues ' .QueryTables(1).Refresh BackgroundQuery:=False' den er kaldt i toppen .Range("D78:E102").Copy .Range("AB83:AC107").PasteSpecial xlValues .Shapes("Button 11").Select With Selection With .Font .Name = "Arial" .FontStyle = "Regular" .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = 9 End With End With End With Application.ScreenUpdating = True End Sub
Tak, det virker helt perfekt nu. Kan du mon også knække denne nød?...
Når der er scoret, markeres en bolle ud for kampen, og lydfilen dong.wav afspilles. Lydfilen har hidtil skullet ligge lokalt på pc'en, og makroen henviste således:
Sub Dong() Dim WAVFile As String Const SND_ASYNC = &H1 Const SND_FILENAME = &H20000 WAVFile = "c:\windows\dong.wav" Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME) End Sub
Nu kunne jeg godt tænke mig at flytte lydfilen ud på internettet, så tipperne ikke skal have den liggende et bestemt sted lokalt. Men hvis jeg ændrer følgende linje, afspiller den alligevel ikke lyden - og giver heller ingen fejl:
Marker mit navn i boksen til venstre og tryk accepter
Synes godt om
Ny brugerNybegynder
Din løsning...
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.