Graf på baggurnd af krydser

Hvilken version af Excel?

PS: Hvad er formålet med denne "graf"?

Version 2003.

Formålet er, at i tilfælde af en masse krydser kan ledere bruge grafen til at give et bedre overblik.

Er der ingen der kan hjælpe? Alternativet er at bruge MS Project, hvilket jeg vil undgå...

Ja - men efter at have set på den uploadede fil - så synes jeg ikke det er muligt/giver mening at fremstille en graf på dette grundlag.

Du skriver at det skal give lederne et bedre overblik  - vedrørende??

Men jeg kan have misforstået situationen...

Det er meningen, at de forskellige personer skal sætte nogle krydser for hvornår deres projekter går i gang. Når alle har sat deres krydser, skal ledelsen kigge på tidslinjen og vurdere, om nogle projekter skal udskydes.

Derfor er det en klar fordel at have streger mellem krydserne.

Hvis muligt - så prøv venligst at sende en prøve på, hvordan du tænker dig stregerne placeret. Upload eller send direkte - mailadr. under profil.

Du kan finde filen på

https://apps.memopal.com/d/?PL2WFDBB

Det er ikke vigtigt med placeringen af stregerne hen til punkterne, hvor der starter flere projekter samme måned. De skal bare alle forbindes måned for måned.

Tak - så er der ingen tvivl..

I skrivende stund ser det ud til at være muligt - vender tilbage.

Hvis du sender en mail (adr. under profil) - så returnerer jeg version 1...

Koden ser således ud:

Rem Version 1 - 22. august 2009
Rem ===========================
Const Lmod = 11
Const Tmod = 4.9

Const førsteRæk = 17                                'Tilpasses
Const sidsteRæk = 25                                '-
Const førsteKol = 2                                '-
Const sidsteKol = 37                                '-

Dim xTabel()

Dim ræk As Integer, kol As Byte, antalx As Integer, ix As Integer
Public Sub forbindKrydser()
    antalx = optælAntalX(førsteRæk, sidsteRæk, førsteKol, sidsteKol)
    sletGlStreger
   
    ReDim xTabel(antalx)
    ix = 0
   
    For kol = førsteKol To sidsteKol
        For ræk = sidsteRæk To førsteRæk Step -1
            If Cells(ræk, kol).Value = "x" Then
                adr = Cells(ræk, kol).Address
                xTabel(ix) = adr
                ix = ix + 1
            End If
        Next ræk
    Next kol
   
    tegnStreger
End Sub
Private Function optælAntalX(førsteRæk, sidsteRæk, førsteKol, sidsteKol)
    optælAntalX = 0
    For Each cc In Range(Cells(førsteRæk, førsteKol), Cells(sidsteRæk, sidsteKol))
        If cc.Value = "x" Then
            optælAntalX = optælAntalX + 1
        End If
    Next
End Function
Private Sub tegnStreger()
Dim ix, x1, y1, x2, y2
    For ix = 0 To antalx - 2
        Range(xTabel(ix)).Select
        x1 = ActiveCell.Left + Lmod
        y1 = ActiveCell.Top + Tmod
       
        Range(xTabel(ix + 1)).Select
        x2 = ActiveCell.Left + Lmod
        y2 = ActiveCell.Top + Tmod
       
        ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
    Next ix
End Sub
Private Sub sletGlStreger()
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next
End Sub

Var det noget, der kunne bruges?

Jeg havde ikke set, at du havde svaret... Men jeg har lige sendt dig en mail med min mailadresse.

OK - er på vej ......

Det er simpelthen genialt. Det er lige præcis hvad jeg efterspørger. :-)

Smid et svar så du kan få point.

PS: Skal jeg rette i de andre koder (lmod og tmod)? I så fald, hvad betyder de?

Lmod = justering af LEFT
Tmod = justering af TOP
skal ikke justeres - anvendes til at få flyttet stregen fra cellens øverste venstre  hjørne til i nærheden af x'et.

Tak for udmeldingen - her er et svar...