Excel技巧接龙

zsj1101

判斷工作表是否打開
   Function BookOpen(Bk As String) As Boolean
     Dim t As Excel.Workbook
     Err.Clear
     On Error Resume Next
     Set t = Application.Workbooks(Bk)
     BookOpen = Not t Is Nothing
     Err.Clear
     On Error GoTo 0
   End Function

zsj1101

設置連續列印報表頁碼
   Sub SetupFooter()
       Dim She       As Worksheet
       Dim SelSheet  As Variant
       If ActiveWindow.SelectedSheets.Count = 1 Then
          Set SelSheet = ActiveWorkbook.Sheets
       Else
          Set SelSheet = ActiveWindow.SelectedSheets
       End If
   
       For Each She In SelSheet
           She.Activate
           X = X + ExecuteExcel4Macro("Get.Document(50)")
       Next
       'SelSheet.Select
       For Each She In SelSheet
           She.Activate
           ActiveSheet.PageSetup.CenterFooter = "&+" & T & "/" & X & "頁"
           T = T + ExecuteExcel4Macro("Get.Document(50)")
       Next
       Set SelSheet = Nothing
   End Sub

zsj1101

取得指定目錄下的子目錄及文件
   Sub CurrentDirectoryFile(MyPath As String, Optional MyName As String = vbNullString)
       MyPath = "D:\"
       If MyName = vbNullString Then
          MyName = Dir(MyPath, vbDirectory)         'Directory
       Else
          MyName = Dir(MyPath & MyName, vbNormal)   'Files
       End If
       Do While MyName <> ""
          If MyName <> "." And MyName <> ".." Then
             If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                Debug.Print "Folder:" & MyName
             Else
                Debug.Print "File:" & MyName
             End If
          End If
          MyName = Dir
       Loop
   End Sub
   

zsj1101

設置保護工作表后可使用篩選
   Sub AutoFilter()
       ActiveSheet.EnableAutoFilter = True
       ActiveSheet.Protect contents:=True, userInterfaceOnly:=True
   End Sub
   

zsj1101

顯示所有打開IE的地址
   'Microsoft Internet Controls
   Dim dWinFolder As New ShellWindows
   Private Sub Form_Load()
     Dim objIE As Object
     For Each objIE In dWinFolder
         If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) <> 0 Then
            Debug.Print objIE.LocationURL
         End If
     Next
   End Sub

zsj1101

獲取OFFICE版本
   Sub Excel_Ver()
       Dim X, Y As String
       X = Application.Version
       select case  X
       case 8#
            Y = "97"
       case 9#
            Y = "2000"
       case 11#
            Y = "2003"
       end select
       MsgBox Y, , "Excel版本"
   End Sub
　

zsj1101

選擇有背景顏色的單元格
   Function RangeSelect(sReg as Range)
     Dim Nx  As Range
     Dim Job As Range
     For Each Nx In sReg
         Nx.Select
         If ExecuteExcel4Macro("GET.CELL(63)") <>0 Then
            If Job Is Nothing Then
               Set Job = Nx
            Else
               Set Job = Union(Job, Nx)
            End If
         End If
     Next
     Job.Select
   End Sub   

xiexiaojing

请问有没有Excel的群呀!有可以加我吗?

我的QQ是237102675

金珂

看君一张贴，胜读十天书。精彩！

m_fly800

小小一个excel就有这么多名堂

怪不得要活到老学到老

大家加油

好贴多发

重复贴就不要发了