27. marts 2012 - 13:47Der er
16 kommentarer og 1 løsning
Excel VBA - ophæv script
Hej, flg. kode skal anvendes i excel (2007 på XP SP3) og er lavet på siden "ThisWorkbook" så koden er anvendelig på flere "ens" sider for forskellige produkter. Den tjekker om "Yes" er sat i celle F12 hvorefter en MessageBox kommer op med svarmulighed "Yes" / "No". Ved "Yes" føres man til Startsiden hvor et nummer skal indtastes manuelt - det virker fint.
Problem: MessageBoxen bliver ved at poppe up såfremt der i F12 står "Yes" og der vælges "No" i MessageBoxen. MSgBox forsvinder når der trykkes "No" men popper op så snart man med musen stiller sig i en celle - sikkert fordi der er valgt "SheetSelectionchange" i proceduren (metoden 'Change' er ikke tilgængelig for "ThisWorkbook". Jeg har forsøgt at lukke Wscript med 'Wscript Quit' - men det virker ikke - VBA melder fejl.
Er der nogen der kan hjælpe med en løsning?
KODEN ========================================= Private Sub workbook_sheetSelectionchange(ByVal Sh As Object, ByVal Target As Range) If ActiveSheet.Range("F12").Value = "Yes" Then Set objshell = CreateObject("Wscript.Shell") intMessage = MsgBox("You applied for a XXXX item. Add Item Number on Start Page !", _ vbYesNo, "Item Number") End If If intMessage = vbYes Then Application.GoTo shSTARTSHEET.Range("F13") ', True End If End Sub =========================================
Private Sub Workbook_SheetActivate(ByVal Sh As Object) If ActiveSheet.Range("F12").Value = "Yes" Then Set objshell = CreateObject("Wscript.Shell") intMessage = MsgBox("You applied for a XXXX item. Add Item Number on Start Page !", _ vbYesNo, "Item Number") End If If intMessage = vbYes Then Application.GoTo shSTARTSHEET.Range("F13") ', True End If End Sub
Det er når der i en dropdown menu i celle F12 vælges "Yes". Ved "No" skal MessageBoxen ikke komme frem. Når den er fremme kan der igen vælges mellem "Yes" og "No". Ved "Yes" føres man til Startsiden, ved "No" skal MessagebOxen forsvinde - problem er at boxen ved "Yes" i F12 bliver ved at komme frem uanset hvad man gør derefter på siden.
Denne her virker kun, hvis man kommer til at stå i cellen F12. Ellers tror jeg det nemmeste ville være at oprette funktionen i en modul, og så kalde den i hver ark.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target = Range("F12") Then If ActiveSheet.Range("F12").Value = "Yes" Then Set objshell = CreateObject("Wscript.Shell") intMessage = MsgBox("You applied for a XXXX item. Add Item Number on Start Page !", _ vbYesNo, "Item Number") End If If intMessage = vbYes Then Application.GoTo shSTARTSHEET.Range("F13") ', True End If End If End Sub
Har prøver ændringen, men desværre virker det ikke. Der kommer ingen MsgBox frem så der kan foretages et valg (troede ellers lige det var fikset for koden så mere rigtig ud med separat forespørgsel på celle F12).
Lyder som om det er fordi din DropDown menu sådan set ikke er i kontakt med Celle F12, for koden virker fint hos mig, når jeg bare vælger Celle F12 så kommer den med msgboxen.
Så skal det være Change på din DropDown menu du skal bruge istedet for arket.
Ellers så skal du hvis desværre over i Worksheet_Change for at tjekke om cellen er ændret.
Men hvis du ikke har 100 ark, så ville det jo også være muligt.
Så er det nemmest at have koden i et modul, og så kalde den fra arket. Så du stadig kun skal ændre koden 1 sted
Private Sub workbook_sheetSelectionchange(ByVal Sh As Object, ByVal Target As Range) Set shStartSheet = ActiveWorkbook.Sheets("Ark2")
If ActiveSheet.Range("F12").Value = "Yes" And Target.Address = "$F$12" Then Set objshell = CreateObject("Wscript.Shell") intMessage = MsgBox("You applied for a XXXX item. Add Item Number on Start Page !", _ vbYesNo, "Item Number") Else Exit Sub End If
If intMessage = vbYes Then Application.GoTo shStartSheet.Range("F13") ', True End If End Sub
VBA melder fejl med "Invalid use of property" i linien Set shStartSheet = ActiveWorkbook.Sheets("Ark2")?? Er der noget jeg mangler at omdøbe ifht. min fil?
Har tjekket at dropdown menuen er tilknyttet F12 - den er go' nok. Jeg har ikke 100 ark, men problemet er at filen forholdsvist nemt kan udvides så det vil være bedst med en central kode. Derudover er jeg i tvivl om hvordan du mener funktionen skal kaldes fra hvert ark hvis koden er i 'Modules'. Kan du give et eksempel?
Har nu afprøvet begge forslag igen og fundet at de virker - og på samme måde - blot er det kodet forskelligt. I Supertekst's forslag skal linien: Set shStartSheet = ActiveWorkbook.Sheets("Ark2") dog fjernes for at det virker ellers meldes fejl "Invalid use of property".
Eneste ulempe er dog at MsgBoxen kun popper op såfremt man stiller sig direkte i cellen F12 og først efter at et valg er foretaget, dvs. 'selectionchange' proceduren er aktiv. Det er muligt at det kræver kodning i 'Modules' i stedet med funktionskald fra hver side med henvisning til 'Modules'. Jeg er dog ikke så stiv i sådanne funcktionskald så hvis i har et råd der vil det være dejligt!
...Og der fik jeg så lige givet mig selv point or mit eget spørgsmål, FLOT! Det er en OMMER...........IT-Guffe og supertekst skulle gerne begge have point nu - ved ikke om niveauet er fair, har ingen erfaring i dette forum.....men de givne points er ligeligt fordelt.
Og derefter smider denne kode ind. (Koden er stjålet fra Supertekst)
Sub TjekF12(ByVal Target As Range) If ActiveSheet.Range("F12").Value = "Yes" And Target.Address = "$F$12" Then Set objshell = CreateObject("Wscript.Shell") intMessage = MsgBox("You applied for a XXXX item. Add Item Number on Start Page !", _ vbYesNo, "Item Number") Else Exit Sub End If
If intMessage = vbYes Then Application.GoTo shStartSheet.Range("F13") ', True End If End Sub
Hvis du så på de ark hvor det skal gælde smider denne ind:
Private Sub Worksheet_Change(ByVal Target As Range) Call TjekF12(Target) End Sub
Så skulle det gerne virke, sådan som du ønsker det.
Så kommer den først og spørger når F12 bliver ændret.
Ved godt det ikke er helt så dynamisk som det andet, men det er trods alt kun 1 sted du stadig skal ændre koden ;)
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.
