23. marts 2008 - 00:08Der er
18 kommentarer og 1 løsning
Hjælp til at få celler til at navngive arkene
Hej
Nu er jeg endelig ved at være færdig med min arbejdsplan og den virker (næsten) Jeg mangler 2 oplysninger.
1. Kan man lave en formel til at angive uge nummer.evt gennem dato (jeg har en dato celle, bare som dato og uden formel)og som skifter en uge op på næste ark og næste ark osv.
2.Kan jeg få en celle (netop uge celle) til at angive navn på ark? jeg skifter mellem et ark der hedder arbejdsplan og et det hedder ugetimer. Så det kunne jo være genialt hvis mine ark så selv lavede sig om til (arbejdsplan uge ? og ugetimer uge ?.
min arbejdsplan er for 6 uger og indeholder så 12 ark
Nu har jeg fundet ud af en (endda 2 celler) angiver navnet på arket Sheets(ActiveSheet.Name).Name = Range("A2") & " " & Range("B2")
Men jeg kan ikke få de andre ark til reagere på samme måde da det er ark1 der bestemmer over alle de andre ark.
Jeg har også fundet en løsning på en formel hvor dato angiver uge.nr =HELTAL((B4-(DATO(ÅR(B4+(REST(8-UGEDAG(B4);7)-3));1;1))-3+ REST(UGEDAG(DATO(ÅR(B4+(REST(8-UGEDAG(B4);7)-3));1;1))+1;7))/7)+1 Til de andre ark mht. til uge.nr har jeg indsat det ark det skal bruge og det virker.
Så det eneste jeg nu mangler er at en eller anden sjæl forbarmer sig over mig og prøver at hjælp mig med makro kode til at navngive de andre ark.
Indsæt denne makro i dit ark: ---------- Sub Navngiv_ark_celle_A2_B2() Sheets(ActiveSheet.Name).Name = Range("A2") & " " & Range("B2") End Sub ---------- Herefter skal du blot køre makroen 1 gang på hvert enkelt ark. /Be_Nice
Private Sub worksheet_change(ByVal Target As Range) If Not Intersect(Range("A4:V65"), Target) Is Nothing Then With Target Select Case Target.Value Case "AL" .Interior.ColorIndex = 34 Case "TSJ" .Interior.ColorIndex = 26 Case "HBP" .Interior.ColorIndex = 36 Case "HM" .Interior.ColorIndex = 37 Case "MKH" .Interior.ColorIndex = 38 Case "CT" .Interior.ColorIndex = 39 Case "PF" .Interior.ColorIndex = 40 Case "CK" .Interior.ColorIndex = 41 Case "ACO" .Interior.ColorIndex = 42 Case "MDS" .Interior.ColorIndex = 43 Case "CN" .Interior.ColorIndex = 44 Case "SA" .Interior.ColorIndex = 45 Case "JB" .Interior.ColorIndex = 46 Case "JSN" .Interior.ColorIndex = 47 Case "JLK" .Interior.ColorIndex = 48 Case "SVW" .Interior.ColorIndex = 35 Case "SKJ" .Interior.ColorIndex = 50
Case Else .Interior.ColorIndex = xlNone End Select End With End If End Sub
Hvor i dette kan jeg indsætte den makro i har givet?
Private Sub worksheet_change(ByVal Target As Range) If Not Intersect(Range("A4:V65"), Target) Is Nothing Then With Target Select Case Target.Value Case "AL" .Interior.ColorIndex = 34 Case "TSJ" .Interior.ColorIndex = 26 Case "HBP" .Interior.ColorIndex = 36 Case "HM" .Interior.ColorIndex = 37 Case "MKH" .Interior.ColorIndex = 38 Case "CT" .Interior.ColorIndex = 39 Case "PF" .Interior.ColorIndex = 40 Case "CK" .Interior.ColorIndex = 41 Case "ACO" .Interior.ColorIndex = 42 Case "MDS" .Interior.ColorIndex = 43 Case "CN" .Interior.ColorIndex = 44 Case "SA" .Interior.ColorIndex = 45 Case "JB" .Interior.ColorIndex = 46 Case "JSN" .Interior.ColorIndex = 47 Case "JLK" .Interior.ColorIndex = 48 Case "SVW" .Interior.ColorIndex = 35 Case "SKJ" .Interior.ColorIndex = 50
Case Else .Interior.ColorIndex = xlNone End Select End With End If Sheets(ActiveSheet.Name).Name = Range("A2") & " " & Range("B2") End Sub
Nu prøved jeg at bytte min ud med den i havde skrevet, men det vil den ikke godtag.
Hvis du har en hændelses kode ala ovenstående i alle ark, bør det virke ellers kan du indsætte min kode i et alm. modul og så kalde det fra hændelseskoden
så i stedet for Sheets(ActiveSheet.Name).Name = Range("A2") & " " & Range("B2") indsætter du: call test
Følgende kode indsættes i et alm. modul:
Sub test() For Each sh In ThisWorkbook.Sheets sh.Name = sh.Range("A2") & " " & sh.Range("B2") Next End Sub
Jeg vil gerne prøve dit.. Men skal jeg indsætte det i Visual basic Ark1 og er det i worksheet eller general. Yderligere skal den helst selv skrive arbejdsplan eller ugetimer inden den indsætte A2 & B2. Det er skiftevis hver anden.
Fandt ud af hvad du mente, men den virker kun på Ark1 og Ark3 og ikke de efterfølgende ulige ark som skal bruge den. Jeg har indsat call test i dem alle.
Jeg vil gerne sende mit program hvis du vil se det, bare du ikke korser dig, hvis det er er et rodet system. Det er første gang jeg prøver at lave noget der er lidt stort.
Jeg sender det lige alligevel, det er altid godt at få gode råd, især når man er lidt i tvivl omkring hvad man har gang i (jeg ved hvad jeg vil ha' det til, det er mere hvordan der er et spørgsmål.
ok Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Intersect(Target, Range("B4")) Is Nothing Then Exit Sub If Sheets(1).Name <> ActiveSheet.Name Then Exit Sub
For s = 1 To Sheets.Count - 1 Sheets(s).Name = "Ark" & s Next
For s = 1 To Sheets.Count - 1 Step 2 Sheets(s).Name = "Arbejdsplan " & Sheets(s).Range("A2") & Sheets(s).Range("B2") Sheets(s + 1).Name = "Timeplan " & Sheets(s + 1).Range("A1") Next End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
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.