VBA 技巧二

Public Sub 技巧()'保存并关闭工作薄
    Dim wb As Workbook
    Set wb = ThisWorkbook    '可指定任意工作簿
    wb.Close savechanges:=False
    Set wb = Nothing
End Sub

Public Sub 技巧()'查询指定工作薄
    Dim i As Integer, j As Integer
    Dim wb As Workbook
    For i = 1 To Workbooks.Count
        For j = 1 To Workbooks(i).Worksheets.Count
            If Workbooks(i).Worksheets(j).Name = "hhh" Then
                Set wb = Workbooks(i)
                GoTo kkk
            End If
        Next j
    Next i
    MsgBox "没有找到存在有该工作表的工作簿！"
    Exit Sub
kkk:
    MsgBox "指定工作表的工作簿名称为：" & wb.Name
    Set wb = Nothing
End Sub

Public Sub 技巧()’创建多个窗口且并排显示
    Dim i As Integer
    Dim wd As Window
    Set wd = ActiveWindow
    '创建3个新窗口
    wd.NewWindow
    wd.NewWindow
    wd.NewWindow
    Windows.Arrange Arrangestyle:=xlArrangeStyleTiled     '平铺窗口
    MsgBox "已经创建了3个新窗口。下面将关闭这3个新窗口,并恢复原窗口。"
    For i = 1 To Windows.Count - 1
        Windows(Windows.Count - 1).Close
    Next i
    ActiveWindow.WindowState = xlMaximized
End Sub

Public Sub 技巧()‘新建窗口并排显示
    Dim wd As Window
    Set wd = ActiveWindow
    wd.NewWindow
    Windows.Arrange Arrangestyle:=xlArrangeStyleVertical
    MsgBox "下面将关闭新建窗口,并恢复原窗口大小."
    wd.Close
    ActiveWindow.WindowState = xlMaximized
    Set wd = Nothing
End Sub

Public Sub 技巧()’返回当前运行宏的文件所在路径
    Dim wb  As Workbook
    Set wb = ThisWorkbook
    MsgBox "当前宏代码运行的工作簿路径为：" & wb.Path
    Set wb = Nothing
End Sub

Public Sub 技巧()‘获取工作薄的打开方式
    Dim wb As Workbook
    Set wb = Workbooks(1)    '指定任意的工作簿
    If wb.ReadOnly = True Then
        MsgBox "工作簿以只读方式打开！"
    Else
        MsgBox "工作簿以普通方式打开！"
    End If
    Set wb = Nothing
End Sub

Public Sub 技巧()’获取工作薄文件名
    Dim wb As Workbook
    Dim i As Integer
    Dim myBaseName As String
    Set wb = ThisWorkbook         '指定任意工作簿
    myBaseName = wb.Name
    i = InStrRev(myBaseName, ".")
    If i > 0 Then myBaseName = Left(myBaseName, i - 1)
    MsgBox "本工作簿的基本名称：" & myBaseName
End Sub

Public Sub 技巧()‘获取工作薄的所有信息
    Dim wb As Workbook
    Dim myProperties As DocumentProperty
    Columns("A:B").Clear
    Set wb = ThisWorkbook      '可以指定任意的工作簿
    Range("A1:B1").Value = Array("信息名称", "信息数据")
    For Each myProperties In wb.BuiltinDocumentProperties
        With Range("A65536").End(xlUp).Offset(1)
            .Value = myProperties.Name
            On Error Resume Next
            .Offset(, 1).Value = myProperties.Value
            On Error GoTo 0
        End With
    Next
    Columns.AutoFit
    Set wb = Nothing
End Sub

Public Sub 技巧()’判断窗口冻结位置 
    Dim wb As Workbook
    Dim wd As Window
    Set wb = Workbooks(1)      '可以指定任意的工作簿
    Set wd = wb.Windows(1)      '可以指定该工作簿的任意窗口
    With wd
        MsgBox "窗格是否被冻结：" & .FreezePanes
        MsgBox "窗格数目：" & .Panes.Count
        MsgBox "窗格中左上角可见单元格区域地址：" & .Panes(1).VisibleRange.Address
    End With
    Set wd = Nothing
    Set wb = Nothing
End Sub

Public Sub 技巧()‘判断工作薄是否打开，如果打开就激活该工作簿
    Dim wb As Workbook
    Dim myFileName As String
    myFileName = Application.GetOpenFilename("Excel工作簿(*.xls),*.xls")
    If myFileName = "False" Then
        MsgBox "没有选择工作簿"
        Exit Sub
    End If
    On Error Resume Next
    Set wb = Workbooks(Dir(myFileName))
    On Error GoTo 0
    If wb Is Nothing Then    '如果该工作簿还没有打开，就打开它
        Workbooks.Open Filename:=myFileName
    Else
        If wb.FullName = myFileName Then    '如果该工作簿已经被打开，就激活它
            MsgBox "您所指定的工作簿已经被打开！"
            wb.Activate
        End If
    End If
    Set wb = Nothing
End Sub