Hjælp til udarbejdelse af excelskabelon

jeg prøver lige at indsætte billedet af tabellen igen, for at se om det kan blive pænere:

  | A  B                  C              D      E
----------------------------------------------------------
1 |     Damer 50+            Afsluttet       
2 | 1    Kira                  Sorø              1.48,2    3.48,1
3 | 2    Marie                Birkerød          1.56,2    3.52,6
4 | 3    Tine                Bagsværd          1.56,9    3.59,3
5 | 4    Marie                Rungsted          1.59,4    3.59,5
6 | 5    Katrine              Rungsted          2.00,6    4.04,9

2. Maker C1 , vælg Data > Datavalidering, vælg tillad = liste skriv i kilde
Ikke afviklet;Afsluttet;Aflyst

vil det så komme på alle nye ark der bliver oprettet?

ikke automatisk, men det kan laves

1.  kald den med en formular knap
sæt koden ind i et modul

Sub NytArk()
Arknavn = InputBox("Indtast Løbsnummer")
overskrift = InputBox("Indtast Løbsnavn")
  Sheets.Add
  ActiveSheet.Name = Arknavn
  Sheets(Arknavn).Range("B1") = overskrift
End Sub

hvordan laver jeg en formulat knap? Jeg er jo hell Grøn på det her punkt :-)

3. ja, men det kræver at arket beskyttes

Standard er alle celler markeret til at være låst, når arket beskyttes.

Marker alle celler der ikke skal låses, højreklik > Formater celler > Beskyttelse, fjern fluebenet i låst.

Funktioner > beskuttelse > beskyt ark, nu kan du vælge at sætte kode på, men jeg gør det normalt ikke.

4. Ja, men inden arket beskyttes

Formularknap:

Højreklik på menulinien klik på Formular, vælg knappen og træk så en rektangel på arket, hvor du vil have den.

Skal koden for knappen se såldes ud:
Sub Knap1_Klik()
    Sub NytArk()
    Arknavn = InputBox("Indtast Løbsnummer")
    overskrift = InputBox("Indtast Løbsnavn")
      Sheets.Add
      ActiveSheet.Name = Arknavn
      Sheets(Arknavn).Range("B1") = overskrift
    End Sub
End Sub

Nej kun en af dem

Sub NytArk()
    Arknavn = InputBox("Indtast Løbsnummer")
    overskrift = InputBox("Indtast Løbsnavn")
      Sheets.Add
      ActiveSheet.Name = Arknavn
      Sheets(Arknavn).Range("B1") = overskrift
  End Sub
eller

Sub Knap1_Klik()
        Arknavn = InputBox("Indtast Løbsnummer")
    overskrift = InputBox("Indtast Løbsnavn")
      Sheets.Add
      ActiveSheet.Name = Arknavn
      Sheets(Arknavn).Range("B1") = overskrift
  End Sub

det kommer an på hvilken en du kalder fra knappen, det kan du altid ændre ved knappen

hov, jeg ser lige at det er et kopi af hovedarket du vil have, altså med alle data, så skal jeg lige lave koden om.

Er det ikke korrekt. ?

ikke helt, det skal kun være knappen, farven og dropdownboxen i C1.

Kan man i øvrig lave noget vejledning til felterne, så hvis man holder musen hen over, så kommer der en lille vejledning frem?

Vejledning:

Højreklik på cellen indsæt kommentar

Jeg synes ikke rigtig den kopiere farver og dropdownboxen med over når jeg opretter et nyt ark?

nej der skal ny kode til, den du har laver et helt nyt ark,

der er en her, men den tager alt med.

Sub NytArk()
Arknavn = InputBox("Indtast Løbsnummer")
overskrift = InputBox("Indtast Løbsnavn")
ActiveSheet.Copy Before:=Sheets(1)
  ActiveSheet.Name = Arknavn
  Sheets(Arknavn).Range("B1") = overskrift
End Sub


Kan du ikke køre den, og så når du er i det nye ark, start en makro og optag det du sletter, også knappen, hvis den skal væk.

Husk at hvis det ark der kopiers fra er beskyttet skal du fjerne arkbeskyttelsen, for at slette i de celler der er beskyttet.

stop makroen når du er tilfreds, og smid koden herind, så kobler jeg det sammen.

Ps ved du om Tilcali's servere er ude af drift, min mail virker ikke og jeg kan ikke gå på deres hjemmeside ??

det ser ud til det, jeg kan heller ikke komme på deres side

jeg prøver mig lige lidt frem, der er jo lidt som at kode ASP :-)

hvis jeg vil lave et tjek på om sheetnavnet findes i forvejen, kan jeg så det??


Noget med

If Sheet.name = Arknavn Then
  Alert("Løbs nummeret er allerede oprettet")
End if

Sub NytArk()
arknavn = InputBox("Indtast Løbsnummer")
For Each ws In Worksheets
If ws.Name = arknavn Then
MsgBox "Løbs nummeret er allerede oprettet", , "Advarsel"
Exit Sub
End If
Next
overskrift = InputBox("Indtast Løbsnavn")
ActiveSheet.Copy Before:=Sheets(1)
  ActiveSheet.Name = arknavn
  Sheets(arknavn).Range("B1") = overskrift
End Sub

kunne du tænke dig en menustyring, den er god hvis du kommer op på mange ark. ?

den laver hyperlinks til alle ark.

det lyder meget spændende, hvordan laver jeg det??

Jeg tror faktisk jeg er ved at have lavet det som jeg skal, og det er ret blæret :-)

Jeg har lavet et ark jeg har kaldt skabelon, som jeg kopiere fra, men er det muligt at man kan fryse arket, så brugerne ikke kommer til at redigere i skabelonen?

Fryse arket, du kan skjule det, og så tage det frem når du skal bruge det.

Stå på arket vælg

Formater > ark > skjul

og når du vil se det igen

Formater > ark > vis vælg arknavn hvis der er flere

Her er koden til menu arket, hvis du har et ark der hedder Menu, vil det blive overskrevet.

Public Sub Menu()
Dim W As Integer, K As Integer, A As Integer
A = MsgBox("Vil du indsætte et ark ved navn MENU, eller opdatere eksisterende, hvor der er Hyperlink til dine ark", vbYesNo, "MENU OPRETTER  v.Holger Bak ©")
If A = 6 Then
W = 1 ' styrer række inden for hyperlink
K = 1 ' styrer kolonner inden for hyperlink
For Each ws In Worksheets
If ws.Name = "Menu" Then GoTo Findes
Next ws

  Set NewSheet = Worksheets.Add ' opretter nyt ark
  NewSheet.Name = "Menu"        ' navngiver det nye ark
 
Findes:
  Worksheets("Menu").Activate
  Range("a1").Select
  If ActiveCell.Value = "" Then
  ActiveCell.Value = "MENU Styring    v.Holger Bak ©"
  ActiveCell.Font.Color = vbBlue
  ActiveCell.Font.Bold = True
  ActiveCell.Font.Italic = True

    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
    Selection.Merge
        With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 3
    End With
  End If
Range("a2:f31").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents            '    der kan jo være fjernet sider ???
    Range("a2").Select
  '-----------------------------------------Der laves hyperlink til alle ark  -------------
  For Each ws In Worksheets
  Worksheets("Menu").Range("a2:a150").Cells(W, K).Select ' reseverer et område til at skrive hyperlink i
 
    If ws.Name = "Menu" Then GoTo Næste ' Hopper over hovedarket "Menu"
 
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & ws.Name & "'" & "!A1"
    ActiveCell.FormulaR1C1 = ws.Name ' skriver hyperlink på alle sider inden for området
    W = W + 1
Næste:
  Next ws
  '------------------------------Soterer kollonne A ----------------------------
    Range("A2:A150").Select
    Selection.Sort Worksheets("Menu").Columns("A"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     
      '--------------- Flytter data over i 4 kolonner ------------------------
    Range("A31:A59").Select
    Selection.Cut
    Range("B2").Select
    ActiveSheet.Paste
    Range("A60:A88").Select
    Selection.Cut
    Range("C2").Select
    ActiveSheet.Paste
    Range("A89:A117").Select
    Selection.Cut
    Range("d2").Select
    ActiveSheet.Paste
    Range("A118:A146").Select
    Selection.Cut
    Range("e2").Select
    ActiveSheet.Paste
    Columns("A:E").Select
    Selection.ColumnWidth = 22
Range("d30").Select
       
Else
Exit Sub
End If
End Sub

hvor sejt man kan skjule arket :-)

Jeg kigger lige på menuen

Hvordan sætter jeg helt precist menuen ind?

du smider koden i et modul.

Gå tilbage på et ark

vælg Funktioner > makro > makroer menu afspil

Jeg har været lidt fræk at lave følgende kode til addSheet knappen:

Sub AddSheet()
    Do Until arknavn > ""
        arknavn = InputBox("Indtast Løbsnummer")
        For Each ws In Worksheets
        If ws.Name = arknavn Then
            MsgBox "Løbs nummeret er allerede oprettet", , "Advarsel"
            arknavn = ""
        End If
    Next
    Loop
    Do Until overskrift > ""
        overskrift = InputBox("Indtast Løbsnavn")
    Loop
    ActiveSheet.Copy Before:=Sheets("skabelon")
    ActiveSheet.Name = arknavn
    Sheets(arknavn).Range("B1") = overskrift
End Sub

Jeg har lavet loopne for at der ikke skal komme en fejl, hvis der ikke er indtastet et sheetnavn og et løbsnavn, men nu kan man kun komme ud af funktionen hvis man indtaster noget,og det er jo ikke godt, hvis man kommer til at trykke på knappen ved en fejl :-(

den skal køres igen, hvis de nye ark skal med, som du sætter ind senere.

Kan man få menuen til at køre hele tiden, så den hele tiden er up to date?

Du kan kalde den fra din knapkode

Sub AddSheet()
    Do Until arknavn > ""
        arknavn = InputBox("Indtast Løbsnummer")
        For Each ws In Worksheets
        If ws.Name = arknavn Then
            MsgBox "Løbs nummeret er allerede oprettet", , "Advarsel"
            arknavn = ""
        End If
    Next
    Loop
    Do Until overskrift > ""
        overskrift = InputBox("Indtast Løbsnavn")
    Loop
    ActiveSheet.Copy Before:=Sheets("skabelon")
    ActiveSheet.Name = arknavn
    Sheets(arknavn).Range("B1") = overskrift
call menu
End Sub

kan man ikke få afspillet makroen når man evt gør arket (menuen) aktiv?

aha, det var smart, men har du en løsning på det med løkken som jeg nævnte 24/03-2004 21:05:30

jeg kikker på det

hvis koden skal køre mår arket menu aktiveres så:

sæt dette ind i menu arkets modul

Private Sub Worksheet_Activate()
Call Menu
End Sub

Do Until arknavn > ""
        arknavn = InputBox("Indtast Løbsnummer")
        If arknavn = "" Then Exit Sub            ' NY LINIE
        For Each ws In Worksheets
        If ws.Name = arknavn Then
            MsgBox "Løbs nummeret er allerede oprettet", , "Advarsel"
            arknavn = ""
        End If
    Next
    Loop
    Do Until overskrift > ""

Jeg har lavet følgende i min addSheet funktion:

ActiveSheet.Copy Sheets("skabelon")

jeg troede at det ville sikre at den altid lavede en kopi af det skjulte ark der hedder skabelon, men det ser ud til at den laver en kopi af det sheet man klikker på knappen fra

Når du kopier et skjult ark er det nye ark også skjult så:

Sub NytArk()
  Do Until arknavn > ""
        arknavn = InputBox("Indtast Løbsnummer")
        If arknavn = "" Then Exit Sub
        For Each ws In Worksheets
        If ws.Name = arknavn Then
            MsgBox "Løbs nummeret er allerede oprettet", , "Advarsel"
            arknavn = ""
        End If
    Next
    Loop
    Do Until overskrift > ""
        overskrift = InputBox("Indtast Løbsnavn")
    Loop
   
    Sheets("skabelon").Copy Before:=Sheets("skabelon")
    ActiveSheet.Name = arknavn
    Sheets(arknavn).Range("B1") = overskrift
    Sheets(arknavn).Visible = True
 
End Sub

Så virker det sku...

Du ksal have tusind tak for hjælpen...du har fortjent hvert et point.

Det kan være jeg forsøger at omformatere menuen lidt i morgen, så det kan være jeg skriver lidt der, håber det er okay.

Fortsat god aften

selv tak og tak for pointz ;-))

en lille ting hvordan tjekker jeg på indtastningen i et feldt, så tids felterne altid har formatet 1.25,10 altså ##.##,## eller #.##,## ??

Jeg var inde og kigge her: Data > Datavalidering men fik det ikke til at virke

Formater > celler > tal > Karegori: brugerdefineret Type: tt.mm,ss

nb skal stadigvæk tastes ind sådan tt:mm:ss

skal jeg også skrive på samme måde, hvis der er tale om minutter.sekunder,millisekunder?

det er da ikke så praktisk at man skal skrive dem med kolon :-)

nej, men hvis du ikke intaster som tid, virker det ikke.

Ellers må du prøve andre formater, men det er svært for Excel ved at et "." er tusindtalsseparator og "," er decimal.

okay, jeg prøver mig frem. Tak fo hjælpen :-) endnu engang