|
- '*********************************
- '******* QQ:14885553 ******
- '*********************************
- Sub Opiona()
- 'On Error Resume Next '// 发生错误,自动执行下一句,就是忽略错误
- Application.ScreenUpdating = False '//关闭屏幕刷新
- Application.DisplayAlerts = False '//关闭系统提示
- t = Timer '//开始时间
- Set SH0 = Sheets("Sheet1")
- SH0.Range("A2:A65536").ClearContents
-
- FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
- For I = 0 To UBound(FileArr)
-
- Str_coon = "HDR=NO';Data Source =" & FileArr(I) '//OFFICE2003,2007 通用
- StrSQL = "SELECT SUM(F1) FROM [Sheet1$] WHERE F1<100"
- SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
- If SQLARR(0, 0) > 0 Then
- SH0.Hyperlinks.Add Anchor:=SH0.Range(SH0.Cells(I + 2, 1).Address), Address:=FileArr(I), TextToDisplay:="" & GetPathFromFileName(FileArr(I), True) & "" '//添加超链接
- End If
-
- Next I
- Application.ScreenUpdating = True '//恢复屏幕刷新
- Application.DisplayAlerts = True '//恢复系统提示
- MsgBox "一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!" '//提示所用时间
- End Sub
复制代码 |
|