无法在一张纸上运行两组代码

时间:2015-04-27 01:22:04

标签: excel vba excel-vba

我需要VBA的帮助,因为我是这种编程语言的新手。是否可以在工作簿中的一个工作表中有两组不同的代码?

我想让Excel工作表更具交互性,例如单击某个单元格,然后突出显示选中单元格的整行。但是我试图让它互动的表格已经有了一套代码。

以下是我要使Excel工作表交互式的代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    initializeWorksheets
    Dim ws As Worksheet

    For Each ws In Worksheets
        ws.Activate
        ' Clear the color of all the cells
        Cells.Interior.ColorIndex = 0
        If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        With ActiveCell

            ' Highlight the row and column that contain the active cell, within the current region
            Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 6

        End With
    Next ws  
    Application.ScreenUpdating = True    
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'filtering
    Dim ws As Worksheet
    ws.Activate

    Dim ccolumn As Integer
    Dim vvalue As String

    ccolumn = ActiveCell.Column
    vvalue = ActiveCell.Value

    For Each ws In Worksheets
    If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub
        Application.ScreenUpdating = False
        With ActiveCell
            Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).AutoFilter Field:=ccolumn, Criteria1:=vvalue
            Cancel = True
        End With
    Next ws
End Sub

以下是用于同一张纸的代码:

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    initializeWorksheets
    Application.ScreenUpdating = False
    If (ActiveSheet.Name = "Student Viewer") Then
        searchKey = Trim(Target.Range.Value)
        If (Right(searchKey, 1) = ")") Then
            searchKey = Right(searchKey, Len(searchKey) - InStrRev(searchKey, "(", -1))
            searchKey = Left(searchKey, Len(searchKey) - 1)
        End If
        temp = 2
        Do While (mainSheet.Range(findColumn(mainSheet, "IC Number") & temp) <> searchKey & "")
            temp = temp + 1
            If (temp > 65535) Then
                MsgBox ("Error in Finding xxxx Details")
                End
            End If
        Loop

        viewerSheet.Unprotect
        ' Set details
        For i = 2 To 10
            viewerSheet.Range("C" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("B" & i), Len(viewerSheet.Range("B" & i)) - 1)) & temp)
            viewerSheet.Range("F" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("E" & i), Len(viewerSheet.Range("E" & i)) - 1)) & temp)
        Next i
        For i = 2 To 3
            viewerSheet.Range("I" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("H" & i), Len(viewerSheet.Range("H" & i)) - 1)) & temp)
        Next i

        loadSummary

        viewerSheet.Protect
    ElseIf (ActiveSheet.Name = "xxxx Viewer") Then
        searchKey = Trim(Target.Range.Value)
        viewerSheet2.Unprotect
        ' Set details
        temp = 2
        Do While (DetailsSheet.Range(findColumn(DetailsSheet, "Policy Num") & temp) <> searchKey & "")
            temp = temp + 1
            If (temp > 65535) Then
                MsgBox ("Error in Finding Details")
                End
            End If
        Loop
        For i = 2 To 11
            viewerSheet2.Range("C" & i) = DetailsSheet.Range(findColumn(DetailsSheet, Left(viewerSheet2.Range("B" & i), Len(viewerSheet2.Range("B" & i)) - 1)) & temp)
        Next i
        For i = 2 To 6
            viewerSheet2.Range("I" & i) = ValuesSheet.Range(findColumn(ValuesSheet, Left(viewerSheet2.Range("H" & i), Len(viewerSheet2.Range("H" & i)) - 1)) & temp)
        Next i
        For i = 7 To 12
            viewerSheet2.Range("I" & i) = DetailsSheet.Range(findColumn(DetailsSheet, Left(viewerSheet2.Range("H" & i), Len(viewerSheet2.Range("H" & i)) - 1)) & temp)
        Next i
        viewerSheet2.Hyperlinks.Add Anchor:=Range("C2"), Address:="", SubAddress:="'Client Viewer'!A1"
        loadDetail
        viewerSheet2.Protect
    End If

    Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

如评论所述,您可以尝试这种方法:

var w = window.open(<your local url>);
w.document.write('<html><head>...</head><body>...</body></html>');

正如您在上面所看到的,Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo halt Application.EnableEvents = False With Me ' Me refers to the worksheet where you put this code .Cells.Interior.ColorIndex = -4142 ' xlNone If Not CBool(-Target.Hyperlinks.Count) Then ' Check if there is hyperlink Target.EntireRow.Interior.ColorIndex = 6 ' or you can use RGB(255, 255, 0) Else Target.Hyperlinks(1).Follow ' follow hyperlink if there is CodeFromYourFollowHyperlinkEvent ' call a routine End If End With moveon: Application.EnableEvents = True Exit Sub halt: MsgBox Err.Description Resume moveon End Sub 应该是一个包含您想要在CodeFromYourFollowHyperlinkEvent事件中完成的内容的子广告,如下所示。

FollowHyperlink

现在请注意,您需要明确地处理您的对象 要了解更多相关信息,check this cool post out