Wednesday, November 29, 2006

Putting file drive location in the title bar

http://blog.livedoor.jp/andrewe/archives/cat_415504.html

"Colo showed me how to use an Application Event when I was making Cell Spotter. Rather than apply to just one worksheet or workbook, the application level DoubleClick event that Cell Spotter uses applies to all open workbooks.

'So I was thinking the other day how I could use this to show file locations in the title bar when I open workbooks. (The Full Name gets a bit long and won't always fit inside the title bar, so I just settled for the drive where the file is stored)

'Here's to how to do it.

'First go to the Visual Basic Editor. (Push the Alt + F11 keys) Then add a standard module and insert this code.

Public XL As New ShowDrive

Private Sub Auto_Open()
Set XL.App = Application
End Sub

'Then add a Class Module and add this code. (The Class Module name must be the same as after where it says "New" in the code above - in this case "ShowDrive")

Public WithEvents App As Excel.Application

Private Sub App_WorkbookOpen(ByVal Wb As Excel.Workbook)
On Error Resume Next
If Wb.Name <> "PERSONAL.XLS" Then _
ActiveWindow.Caption = Left(Wb.FullName, 2) & " " & Wb.Name
End Sub

'Note this code only works if the workbook is saved (New workbooks don't really have full names until they are saved, also the Personal.xls file has been coded out using If...Then...)

'Hmm, this works fine but a problem occurs when the file is saved. If the drive is different I won't have any way of checking if the drive has changed because a BeforeSave event can't be used in this case, not as far as I know anyway :-)

'So I added this SelectionChange code instead. This works when other cells are selected so it should work assuming you select some cells after saving.

'Make sure it's placed in the class module too.

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error Resume Next
If Len(Application.Substitute(Sh.Parent.Name, ".xls", "")) <> Len(Sh.Parent.Name) Then _
ActiveWindow.Caption = Left(Sh.Parent.FullName, 2) & " " & Sh.Parent.Name
End Sub

'Now for the final step. Close the Visual Basic Editor, then save the workbook as an add-in by selecting Save As from the File Menu, then Microsoft Excel Add-In from the "Save as type:" drop down list under where it says "File name:".

'Go to Tools, Add-Ins and install it. (Use the Browse button to find add-ins not shown in the list)

Keep in mind the ShowDrive class module is where the event code works, you can adjust it to do whatever you like ;-)"

No comments: