现在的位置: 首页 > 综合 > 正文

VBA之自动建立连接

2013年08月02日 ⁄ 综合 ⁄ 共 1637字 ⁄ 字号 评论关闭

                        

     马上公司就要进行CMMI评估了,所以需要现在将PIID表和实际项目及过程相关文件建立连接,以方便评估时进行证据的查找。每一个PA的每个SP,GP对应的每个项目都至少需要一个直接证据和一个间接证据,这可苦了我们这些ATM人员了,为了能够减少点负担,所以写了这个宏,让其能根据所单击的单元格,自动定位到相应的项目的目录,然后ATM人员根据情况进行选择文件或者目录,具体宏的内容如下:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call SelectFile(Target)
End Sub
Sub SelectFile(ByVal Target As Range)
    Dim strURL As String
    Dim strCol As String
    strURL = "\\192.168.2.10\cmmi3\"
    If Target.Cells.Count = 1 Then
        If UCase(Target.Value) = "X" Then
            If Target.Hyperlinks.Count = 1 Then
                strURL = Target.Hyperlinks.Item(1).Address
            Else
                strCol = Right(Left(Target.Address, 2), 1)
                Select Case strCol
                    Case "H"
                        strURL = strURL + "EPG\XXX_CMMI_DEFINITION\"
                    Case "I"
                        strURL = strURL + "Project1\"
                    Case "J"
                        strURL = strURL + "Project2\"
                    Case "K"
                        strURL = strURL + "Project3\"
                    Case "L"
                        strURL = strURL + "Project4\"
                    Case Else
                        Exit Sub
                End Select
            End If
            With Application.FileDialog(msoFileDialogFilePicker)
                .InitialFileName = strURL
                If .Show = True Then
                    'MsgBox .SelectedItems(1)
                    Target.Hyperlinks.Add(Anchor:=Selection, Address:=.SelectedItems(1), TextToDisplay:="X")
                    Exit Sub
                End If
            End With
            'Select folder
            With Application.FileDialog(msoFileDialogFolderPicker)
                .InitialFileName = strURL
                If .Show = True Then
                    Target.Hyperlinks.Add(Anchor:=Selection, Address:=.SelectedItems(1), TextToDisplay:="X")
                    Exit Sub
                End If
            End With
            'Input link by manual
            If Target.Hyperlinks.Count = 1 Then
                strURL = InputBox("Please input link address:", "Input", strURL)
            Else
                strURL = InputBox("Please input link address:", "Input", "http://planner.jfsys.com:8080/xplanner2/do/view/projects")
            End If
            If Len(strURL) > 0 Then
                Target.Hyperlinks.Add(Anchor:=Selection, Address:=strURL, TextToDisplay:="X")
            End If
        End If
    End If
End Sub

当然其中有部分是常量,大家可以根据需要修改。(版权所有,转载请注明出处!http://lazybee.cnblogs.com/

抱歉!评论已关闭.