Sheet Exist funktion

..og så lige koden:

Function SheetExists(IBox As String) As Boolean
' returnerer TRUE dersom arket finnes i den aktive arbeidsboken
    SheetExists = False
    'On Error GoTo NoSuchSheet
    If Len(Sheets(IBox).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function


Private Sub CommandButton2_Click()
Unload Me
Dim IBox As String
Dim sPath As String
sPath = "\\hjertesrv\faelles\Index\dokumenter\Booking\PCI og KAG\"
IBox = InputBox("Indtast bookingdato")
If IBox <> "" Then
Workbooks.Open sPath & ("PCI og KAG.xls")

Application.ScreenUpdating = False

If Not SheetExists(IBox) Then
    Dim Msg, Style, Title, Response, MyString
    Msg = "Bookingdatoen:" & " " & IBox & " " & "eksisterer ikke! Skal der oprettes en ny? "
    Style = vbYesNo + vbDefaultButton2    ' Define buttons.
    Title = "Meddelelsesbox"    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then
   
    ActiveSheet.Copy Before:=ActiveSheet
    With ActiveSheet
        .Range("F2").Value = IBox
        .Name = IBox
        .Range("B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33,B35").ClearContents
        .Range("D5:D36").ClearContents
    End With
        If Sheets("Sheet1").Visible = True Then
        Sheets("Sheet1").Visible = False
        End If
    Else:
    GoTo Slut
    End If

Else:
Sheets(IBox).Activate

End If
Else:
MsgBox ("Indtast en dato")
End If
Exit Sub
Slut:
End Sub

Private Sub CommandButton2_Click()
Unload Me
Dim IBox As String, X As Boolean
Dim sPath As String
X = False
sPath = "\\hjertesrv\faelles\Index\dokumenter\Booking\PCI og KAG\"
IBox = InputBox("Indtast bookingdato")
If IBox <> "" Then
Workbooks.Open sPath & ("PCI og KAG.xls")

Application.ScreenUpdating = False
'***************************************
For Each Ws In Worksheets ' tjekker alle ark
  If Ws.Name = IBox Then  ' hvis navnet findes
  Worksheets(IBox).Activate ' aktiveres
  X = True                  ' true = arket er fundet
  End If
Next
If X = False Then ' hvis ikke fundet
'**********************************************************
    Dim Msg, Style, Title, Response, MyString
    Msg = "Bookingdatoen:" & " " & IBox & " " & "eksisterer ikke! Skal der oprettes en ny? "
    Style = vbYesNo + vbDefaultButton2    ' Define buttons.
    Title = "Meddelelsesbox"    ' Define title.
    Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then
   
    ActiveSheet.Copy Before:=ActiveSheet
    With ActiveSheet
        .Range("F2").Value = IBox
        .Name = IBox
        .Range("B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33,B35").ClearContents
        .Range("D5:D36").ClearContents
    End With
        If Sheets("Sheet1").Visible = True Then
        Sheets("Sheet1").Visible = False
        End If
    Else:
    GoTo Slut
    End If


End If
Else:
MsgBox ("Indtast en dato")
End If
Exit Sub
Slut:
End Sub


du skal ikke bruge funktionen
Function SheetExists(IBox As String) As Boolean

Det fungerer rigtig godt. Men det er lidt mærkeligt at det andet ikke fungerer - før jeg begyndte at ændre for meget virkede det godt nok :0( - men pyt nu virker det.
kabbak: Et lille tillægsspørgsmål som intet har med ovennævnte at gøre (bare sig hvis jeg skal oprette et nyt spørgsmål): Kender du til vba der udfra dato kan returnere ugenr og ugedag. Jeg har fundet flere men ingen fungerer på min engelske variant af XP og det andet problem er at softwaren efterfølgende skal fungere i en dansk variant

Hov er det muligt at ændre koden så man ikke ser projektmappen PCI og KAG.xls inden det nye ark indsættes?

Ugenr og ugedag:

Function Week(InputDate As Date)
    Week = DatePart("ww", InputDate, vbMonday, vbFirstFourDays)
End Function

Function DayOfWeek(InputDate As Date)
Dim vDage
vDage = Array("Mandag", "Tirsdag", "Onsdag", "Torsdag", "Fredag", "Lørdag", "Søndag")
DayOfWeek = vDage(Weekday(InputDate, vbMonday) - 1)
End Function


ps. din SheetExist virker ikke når du har inaktiveret On error Goto linien

Denne her plejer jeg at bruge
Private Function SheetExists(sname) As Boolean
'  Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

( Hov er det muligt at ændre koden så man ikke ser projektmappen PCI og KAG.xls inden det nye ark indsættes?)

Det tror jeg ikke, en inputbox, kan vist nok ikke vises hvis, excel er minimeret.

Det kan være at Bak har en anden mening.

-->bak Hvorledes bruges ovenstående funktioner - har du forslag til VBA

kald fra VBA

Uge = week(Dato)
Dag = DayOfWeek(Dato)

Dato  er en variabel der indeholder datoen

Jeg kan fint lave en vba der laver ovenstående men jeg ville egentlig gerne om ugenr fremkom i Range("F3") når dato blev indsat i F2. Hvordan gøres det?
Og iøvrigt tak til jer begge for hjælpen igen igen igen.....

I F3 = hvis(F2<>"";week(F2);"")

eller fra din kode

  .Range("F2").Value = IBox
  .Range("F3").Value = DayOfWeek(Ibox)

.Range("F3").Value = Week(Ibox)

selvfølgelig

Det var bare super - så har jeg jo heller ikke problemet med Dansk/engelsk :0)  Tak igen

selv tak ;-))

Hov der er fejl følgende sted -- hva har jeg nu gjort forkert:

    ActiveSheet.Copy Before:=ActiveSheet
    With ActiveSheet
        .Range("F2").Value = IBox
        .Range("F3").Value = Week(IBox)
        .Range("E2").Value = DayOfWeek(IBox)
        .Name = IBox
        .Range("B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33,B35").ClearContents
        .Range("D5:D36").ClearContents
    End With

Udfor .Range("F3").Value = Week(IBox)  IBox highlightes: Følgende: Compile error. ByRef argument type mismatch

Nå IBox skulle dim'es som Date :0)

Jeg har ændret lidt pga ovenstående men den fejler ved: Worksheet(Ibox).Activate hvorfor jeg har skrevet: On error goto Slut - men den selekter derved ikke korrekt

du skulle have ændret
Function DayOfWeek(InputDate As Date)
til
Function DayOfWeek(InputDate As String)
og
Function Week(InputDate As Date)
til
Function Week(InputDate As String)

så havde det virket med det samme

Du har fuldstænfig ret - tak igen

selv tak