Mangler en makro som kan tegne linjer ud fra talværdier

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.

Mener du, at fx hver anden række skal have en streg,
kan betinget formattering være:
=rest(række;2)=0

Mener du, at fx hver anden række skal have en streg,
kan betinget formattering være:
=rest(række(a1);2)=0

Ja, denne vil fungere.

Men spørgsmålet gik på at styre tegningen af linjer ud fra en talværdi i kolonne A.

Tak for alle forslagene...

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...

Håber nogen kan hjælpe...

Hvilken version af Excel anvender du? Hvis det er 2010 så kan "minidiagrammer" (engelsk sparklines) måske anvendes?

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"

Det er der jeg står nu...

Hvordan virker sparklines...?

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()

    coordinate1 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate2 = ActiveCell().Value
    Selection.Offset(1, -2).Select
    coordinate3 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate4 = ActiveCell().Value
    Selection.Offset(-1, -1).Select
    coordinate5 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate6 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate7 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate8 = ActiveCell().Value
    Selection.Offset(-1, -4).Select
    coordinate9 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate10 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate11 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate12 = ActiveCell().Value
    ActiveSheet.Shapes.AddLine(coordinate1, coordinate2, coordinate3, coordinate4).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
    Selection.ShapeRange.Line.Weight = 12.5
    ActiveSheet.Shapes.AddLine(coordinate5, coordinate6, coordinate7, coordinate8).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 7
    Selection.ShapeRange.Line.Weight = 12.5
    If coordinate1 <> coordinate3 Then
    ActiveSheet.Shapes.AddLine(coordinate9, coordinate10, coordinate11, coordinate12).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 3
    Selection.ShapeRange.Line.Weight = 3#
    End If
   
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 sagt, så virker det upåklageligt i 2003 versionen...

VBA koden bliver aktiveret af nogen kommando knapper i selve regnearket...

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()

    coordinate1 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate2 = ActiveCell().Value
    Selection.Offset(1, -2).Select
    coordinate3 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate4 = ActiveCell().Value
    Selection.Offset(-1, -1).Select
    coordinate5 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate6 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate7 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate8 = ActiveCell().Value
    Selection.Offset(-1, -4).Select
    coordinate9 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate10 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate11 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate12 = ActiveCell().Value
    ActiveSheet.Shapes.AddLine(coordinate1, coordinate2, coordinate3, coordinate4).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
    Selection.ShapeRange.Line.Weight = 12.5
    ActiveSheet.Shapes.AddLine(coordinate5, coordinate6, coordinate7, coordinate8).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 7
    Selection.ShapeRange.Line.Weight = 12.5
    If coordinate1 <> coordinate3 Then
    ActiveSheet.Shapes.AddLine(coordinate9, coordinate10, coordinate11, coordinate12).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 3
    Selection.ShapeRange.Line.Weight = 3#
    End If
   
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

Er dette ikke det samme spørgsmål som:

http://www.eksperten.dk/spm/976844

I så fald så luk dette (tag selv pointene) og kør videre på dette.

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...

Måske:

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

"Delete" kan/må ikke bruges som makro navn.

Prøv med:

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()

    coordinate1 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate2 = ActiveCell().Value
    Selection.Offset(1, -2).Select
    coordinate3 = ActiveCell().Value
    Selection.Offset(0, 2).Select
    coordinate4 = ActiveCell().Value
    Selection.Offset(-1, -1).Select
    coordinate5 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate6 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate7 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate8 = ActiveCell().Value
    Selection.Offset(-1, -4).Select
    coordinate9 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate10 = ActiveCell().Value
    Selection.Offset(1, -1).Select
    coordinate11 = ActiveCell().Value
    Selection.Offset(0, 1).Select
    coordinate12 = ActiveCell().Value
    ActiveSheet.Shapes.AddLine(coordinate1, coordinate2, coordinate3, coordinate4).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 4
    Selection.ShapeRange.Line.Weight = 12.5
    ActiveSheet.Shapes.AddLine(coordinate5, coordinate6, coordinate7, coordinate8).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 7
    Selection.ShapeRange.Line.Weight = 12.5
    If coordinate1 <> coordinate3 Then
    ActiveSheet.Shapes.AddLine(coordinate9, coordinate10, coordinate11, coordinate12).Select
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 3
    Selection.ShapeRange.Line.Weight = 3#
    End If
   
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

Kan man på nogen måde "tvinge" excel 2010 til at opføre sig som 2003 versionen?

På den måde kunne det måske virke...

Virker ikke med den løsning, som "Store-Morten" skriver...

Problemet ligger nok snarere i denne linie:

Range("hi1").Select

Det er ihvertfald der programmet stopper hele tiden...

Som om den ikke kan finde "hi1"...og jeg kan ikke lige selv se hvor den vil pege hen, når den skriver "hi1" i VBA'en

Har du prøvet at ændre?

Range("hi1").Select
Gør at celle HI1 vælges.

Tror faktisk at denne linie kan slettes?

Sub Makingdrawing()
Dim n As Integer
Range("hi1").Select
Delete


Celle HI1 vælges og slettes (Delete) kalder ikke Delete makro.
Står der noget i celle HI1 ?

Okay, det var også det jeg troede...at den ville vælge celle HI1, når der stod sådan...

Men løsningen er ikke at slette linien...så kommer der en anden fejl, med at den ikke kan finde det område som skal slettes...

Kan/vil du sende arket på E-Mail?

Jeps...kan godt sende dig hele arket på mail...

Bare på din mailadresse herinde?

Eller på E-Mail adresse under profil

Nej, der står ikke noget i celle HI1

Okay...sender dig filen på mail nu...så kan du lige se om det er noget som du kan rette på...

Har sendt den til dig på mailen fra din profil...med forklaringer til hvordan det burde virke...

Har sendt retur ;-)

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

Her er en lille film om:
Hvordan man accepterer svar på Eksperten.dk
http://www.youtube.com/watch?v=s26DGiuvXBo

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")

derefter kan du benytte

coordinate1 =  Udgangspunkt
coordinate2 =  Udgangspunkt.Offset(0, 2)
coordinate3 =  Udgangspunkt.Offset(1, -2)

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.

I øvrigt god fornøjelse med din model.

Det er en simpel kode der giver fejl?


Hvis denne fil åbnes med Excel 2010.

http://gupl.dk/692098/