Aktivere Workbook

Hej

I nedenstående hø-klik menu
1) opretter jeg en Excel Workbook eller
2) åbner en workbook eller
3) Aktiverer en workbook

Ad 1) Gennemføres hvis workbooken ikke eksisterer
Ad 2) Gennemføres hvis workbooken eksisterer men ikke er åben
Ad 3) Gennemføres såfremt workbooken eksisterer og er åben

De første 2 fungerer upåklageligt og jeg kan uden problemer (med brug af funktionen WorkbookOpen) detektere om workbooken allerede er åben. Mit problem er få aktiveret workbooken såfremt den allerede er åben altså "set focus". Jeg anvender pt en messagebox som et alternativ (ikke specielt godt)

vh Steen

  Public Function WorkbookOpen(ByVal WorkbookName As String) As Boolean
        'Returns TRUE if the workbook is open
        WorkbookOpen = False
        On Error GoTo WorkBookNotOpen
        If Len(xlApp.Workbooks(WorkbookName).Name) > 0 Then
            WorkbookOpen = True
            Exit Function
        End If
WorkBookNotOpen:

    End Function

    Private Sub ToolStripMenuItem1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem1.Click
        Dim oPath As String = "\\server\faelles\Index data\Observationsskemaer\"
        Dim owb As String = Cpr & ".obs"

        If Cpr <> "" Then

            If Dir(oPath & owb) <> "" Then
                'Undersøger om Excel er startet
                On Error Resume Next
                'Dim xlApp As New Excel.Application
                xlApp = GetObject(, "Excel.Application")

                If Err.Number = 0 Then GoTo næste
                'Ellers starter vi excel
                xlApp = CreateObject("Excel.Application")

næste:

                If WorkbookOpen(owb) = False Then
                    With xlApp
                        .Workbooks.Open(oPath & owb)
                        .Visible = True
                    End With
                Else
                    Process.GetProcessesByName("???")
                    'xlApp.Workbooks(owb).Activate()
                    MsgBox("Observationsskemaet er allerede opstartet")
                End If

            Else
                Dim xlApp As New Excel.Application

                Dim Msg, Style, Title, Response
                Msg = "Skal der oprettes et nyt observationsskema?"    ' Define message.
                Style = vbYesNo + vbDefaultButton2    ' Define buttons.
                Title = "Meddelelsesbox"    ' Define title.
                Response = MsgBox(Msg, Style, Title)
                If Response = vbYes Then
                    With xlApp
                        .Workbooks.Open("\\server\faelles\Index\dokumenter\Observationsskabelon\Patient obs.xls")
                        .Visible = True
                        Dim WB = xlApp.ActiveWorkbook

                        With WB.Worksheets("Ordination")
                            .Range("K2").Value = Navn
                            .Range("F2").Value = Cpr
                            .Range("H2").Value = HCV
                        End With

                        WB.SaveAs(Filename:=oPath & Cpr & ".obs")
                    End With

                End If

            End If
            xlBook.Close()
            xlBook = Nothing
            xlApp = Nothing

        End If
    End Sub