16. februar 2013 - 21:45Der er
31 kommentarer og 1 løsning
Mangler en makro som kan tegne linjer ud fra talværdier
Hej
Håber der er nogen som kan hjælpe...
Jeg mangler en makro som kan få excel til automatisk at tegne vandrette linjer ud fra de talværdier som man taster ind i den venstre kolonne.
Hvis man tilføjer en linie eller fjerner en linie, skal makroen kunne finde ud af hvor den så skal starte påny, efter den nye linie er fjernet/tilføjet...
Som jeg læser dit ønske, så kan dette løses vha. betinget formatering.
F.eks. vil denne formel
=$A1=10
gældende for =$A$1:$K$1
kunne tegne forskellige typer af streger under (eller over) celleområdet, hvis værdien i A1=10. Den kan kombineres med andre regler, som tegner andre streger (i forskellige farver om ønsket), hvis cellen A1 har en anden værdi.
Men måske har jeg ikke forklaret mig grundigt nok...
Det som jeg mangler en makro til, er at hvis jeg i excel har en kolonne med forskellige værdier (sekunder). Så skal der ud for hver værdi kunne dannes en fortløbende streg (tidslinie). Denne tidslinie skal være fortløbende, så begyndelsen af stregen starter hvor den forrige streg sluttede. Dog skal den nye streg starte en række længere nede, så man får en tidslinie, som viser hvert step i sekunder som "bjælker" ud for hver linie med det antal sekunder som står i rækken yderst til venstre...
Jeg anvender version 2010...jeg har lavet programmet i 2003, og da virker mine "streger"...men når jeg åbner det i 2010, så får jeg fejlen "Method 'select' of object 'Range' failed"
Ok. Hvis du allerede har VBA-kode, der virker i Excel 2003, så kan du måske lægge denne ud her (eller uploade til f.eks. GUPL og så vise linket).
Jeg er ikke selv verdensmester i VBA, men der er andre på dette forum, som sandsynligvis vil kunne gennemskue, hvad der skal til for at få koden til at virke i vers. 2010.
Jeg har en VBA-kode som virker i 2003 versionen. Det er når jeg åbner i 2010, den crasher...med den fejl som jeg lige skrev om. Det kode er en del af et større regneark, som skal bruges til noget arbejde... Jeg kan ikke rigtig gennemskue hvor koden "kigger hen"...
Jeg prøver at lægge koden her, så håber jeg nogen kan se hvor det er galt...
Sub Makingdrawing() Dim n As Integer Range("hi1").Select Delete For n = 0 To 35 Range("he9").Select Selection.Offset(2 * n, 0).Select Makinglines Next n Range("e4").Select End Sub Sub Makinglines()
End Sub Sub Delete() Range("hi1").Select ActiveSheet.Lines.Select Selection.Delete Range("c9").Select
End Sub Sub Takt() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") / 2 * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") / 2 * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Sub deletetimes() ' ' deletetimes Macro ' Macro recorded 08/06/2002 by Installer '
' Range("G2:S2,D9:F80").Select Range("D9").Activate Selection.ClearContents Range("C9:C10").Select End Sub Sub Takt100() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Som "bonusinfo" skal jeg måske lige fortælle at det er her makroen crasher:
Sub Makingdrawing() Dim n As Integer Range("hi1").Select Delete For n = 0 To 35 Range("he9").Select Selection.Offset(2 * n, 0).Select Makinglines Next n Range("e4").Select End Sub Sub Makinglines()
End Sub Sub Delete() Range("hi1").Select ActiveSheet.Lines.Select Selection.Delete Range("c9").Select
End Sub Sub Takt() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") / 2 * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") / 2 * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Sub deletetimes() ' ' deletetimes Macro ' Macro recorded 08/06/2002 by Installer '
' Range("G2:S2,D9:F80").Select Range("D9").Activate Selection.ClearContents Range("C9:C10").Select End Sub Sub Takt100() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Har lukket det andet spørgsmål som omhandlede det samme. Så nu kører jeg videre her, og håber nogen kan se en løsning på spørgsmålet om VBA-koden her...
Sub Makingdrawing() Dim n As Integer Range("hi1").Select Delete 'Skal makroen "Delete" kaldes? For n = 0 To 35 Range("he9").Select Selection.Offset(2 * n, 0).Select Makinglines Next n Range("e4").Select End Sub Sub Makinglines()
Sub Delete() Range("hi1").Select ActiveSheet.Lines.Select Selection.Delete Range("c9").Select
Sub Makingdrawing() Dim n As Integer Range("hi1").Select DeleteLines For n = 0 To 35 Range("he9").Select Selection.Offset(2 * n, 0).Select Makinglines Next n Range("e4").Select End Sub Sub Makinglines()
End Sub Sub DeleteLines() Range("hi1").Select ActiveSheet.Lines.Select Selection.Delete Range("c9").Select
End Sub Sub Takt() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") / 2 * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") / 2 * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Sub deletetimes() ' ' deletetimes Macro ' Macro recorded 08/06/2002 by Installer '
' Range("G2:S2,D9:F80").Select Range("D9").Activate Selection.ClearContents Range("C9:C10").Select End Sub Sub Takt100() If Range("g2") = 0 Then MsgBox ("You must enter Takt Time in cell 'G2' first!") End If If Range("g2") > 0 Then coordinate13 = Range("g2") * 10.5 + 330 coordinate14 = 128 coordinate15 = Range("g2") * 10.5 + 330 coordinate16 = 1100 ActiveSheet.Shapes.AddLine(coordinate13, coordinate14, coordinate15, coordinate16).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Selection.ShapeRange.Line.Weight = 3# Range("e4").Select End If End Sub
Er det ikke fordi at "Delete" er en knap i selve regnearket? Så hvis man trykker på knappen "Delete" i regnearket, så kalder den rutinen op i VBA...?
Mener det er sådan den fungerer...
Det med "Sub Delete() er så vidt jeg ved hvis man skal slette noget i regnearket. Så trykker man på Delete-knappen i excel og så udfører den/kalder den på den makro som hedder "Delete"...
Og ja, Makroen "Delete" skal kaldes, den sletter alt inden den tegner påny...det er vist grunden...
Men hele "humlen" er at den fejler ved: Range("hi1").Select
Men jeg kan ikke lige gennemskue hvad den henviser til, når der i VBA'en står "Range("hi1").Select
Ark flyttet til ny Mappe Moduler kopieret over i den ny Mappe Delete() Makro ændret til: DeleteLines() Knapper ændret til ActiveX-objekter Og gemt som Excel 2010 med makroer
Hej TheLeanMan Her er et par tip. Du bør lære at droppe select. Det er i 99% af tilfældene overflødigt og gør din kode langsommere. Jeg kan ikke umiddelbart se, at fejlen skulle have noget med skiftet til 2010 at gøre.
Nu har jeg ikke set dit ark, og jeg kan se dit problem er løst, men det giver ikke umiddelbart mening med den pågældende fejlmeddelelse, da "hi1" findes i samtlige ark, og selvom det er beskyttet kan det vælges med vba. Typisk er fejlen, at området ikke eksisterer i det pågældende ark, men det gør det jo i dette tilfælde?
Angående eksempel på effektiviteten og undgå select, kan jeg foreslå i stedet at benytte range("Sheetx!hi1").delete eller ark1.range("hi1").delete eller sheets("eksempel").range("hi1").delete, det er ikke nødvendigt at "selecte" noget for at slette det, du skal blot huske at benytte arkreference hvis det er en range i et andet ark.
Definitionen af dine koordinater kan du f.eks. også effektivisere en del og samtidig spare nogle kodelinier på. Start med at definere dit udgangspunkt, f.eks. Dim Udgangspunkt as Range Set Udgangspunkt = Ark1.Range("E5")
Value bør ikke være nødvendigt, men det gør formentlig koden en smule hurtigere, så det er fornuftigt at angive det.
I din takt sub behøver du kun ét if statement, da der kun er to muligheder <= 0 eller >0 dvs. if blabla then X else Y end if
Som det er nu kører din kode videre i stedet for at blive afsluttet. Hvis du f.eks. har brug for at afslutte din subrutine i forbindelse med et udfald af et if statement kan du benytte exit sub. Hvis du bare lader koden køre risikerer du at der sker utilsigtede ting.
I øvrigt tror jeg, at det kan lade sig gøre, at gøre det du ønsker uden VBA, men blot ved at benytte dynamisk navngivne områder/formler.
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.
Ny bruger
Nybegynder
Opret
Preview
