VBA之自动建立连接
马上公司就要进行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/)