Hello,
I know almost nothing about Visual Basic, but whenever I open an Excel file I get a VB screen that comes up first and a pop-up window with the warning "Compile Error: Only comments may appear after End Sub, End Function, or End Property". I get the same error message when I close the Excel file. The last time I used Excel I pasted some code into VB because I thought it might fix a problem I was having, but it didn't work so I deleted the entire worksheet.
All of the code is below, hopefully someone can help!
Thanks,
Dennis.
[Added code tags~VP]
I know almost nothing about Visual Basic, but whenever I open an Excel file I get a VB screen that comes up first and a pop-up window with the warning "Compile Error: Only comments may appear after End Sub, End Function, or End Property". I get the same error message when I close the Excel file. The last time I used Excel I pasted some code into VB because I thought it might fix a problem I was having, but it didn't work so I deleted the entire worksheet.
All of the code is below, hopefully someone can help!
Thanks,
Dennis.
Code:
Option Explicit
#Const ExcelCompile = True
Public bWin95 As Boolean
Public bWinNT As Boolean
Public bWinNT351 As Boolean
Public bWinNT40 As Boolean
Public nOSMajorVersion As Integer
Public nOSMinorVersion As Integer
Public theDoc As Worksheet
Private bDistMonOk As Boolean
Private iniFilename As String
Private PDFWriterName As String
Private Port As String
Private Declare Function CopyIconToClipboard Lib "CopyIcon" () As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Or Target.Column = 11 Then
Rows(Target.Row).EntireRow.AutoFit
If Target.RowHeight < 35 Then Target.RowHeight = 35
End If
End Sub
'Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
(ByVal hWnd As Integer, _
ByVal wMsg As Integer, ByVal wParam As Integer, _
lParam As Any) As Long
'Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As String, _
ByVal lpString As String) As Integer
Private Const WM_WININICHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF
Private Type POINT
x As Long
y As Long
End Type
Private Type msg
hWnd As Integer
message As Integer
wParam As Integer
lParam As Long
time As Long
pt As POINT
End Type
'Private Declare Function PeekMessage Lib "User32" Alias "PeekMessageA" _
(ByRef lpMsg As msg, ByVal hWnd As Integer, ByVal wMsgFilterMin As Integer, _
ByVal wMsgFilterMax As Integer, ByVal wRemoveMsg As Integer) As Boolean
Private Const PM_REMOVE = &H1
'Private Declare Function TranslateMessage Lib "User32" Alias "TranslateMessageA" _
(ByRef lpMsg As msg) As Boolean
'Private Declare Function DispatchMessage Lib "User32" Alias "DispatchMessageA" _
(ByRef lpMsg As msg) As Long
Declare Function GetVersion Lib "kernel32" () As Long
Declare Function IsPDFWriterInstalled Lib "DistMon" (ByVal PDFWriterName As String, ByVal Port As String) As Long
Dim bExcel As Boolean
Dim SystemRoot$
Private IniPromptSetting As String
Private Function GetPrivateProfileSetting(Optional iniFilename As String, _
Optional BaseKey As Long, _
Optional Section As String, _
Optional Setting As String) As String
If IsMissing(iniFilename) Or Len(iniFilename) = 0 Then
GetPrivateProfileSetting = QueryValue(BaseKey, Section, Setting)
Else
GetPrivateProfileSetting = GetIniSetting(iniFilename, Section, Setting)
End If
End Function
Private Sub SetPrivateProfileSetting(Optional iniFilename As String, _
Optional BaseKey As Long, _
Optional Section As String, _
Optional Setting As String, _
Optional Value As String)
If IsMissing(iniFilename) Or Len(iniFilename) = 0 Then
SetKeyValue BaseKey, Section, Setting, Value, 1
Else
SetIniSetting iniFilename, Section, Setting, Value
End If
End Sub
Function EnsurePDFWriterIsInstalled(PDFWriterName As String, Port As String) As Boolean
Dim found As Long
Dim starPos As Long
On Error Resume Next
EnsurePDFWriterIsInstalled = False
PDFWriterName = String(100, "*")
Port = String(100, "*")
If (Not bDistMonOk) Then
MsgBox IDS_CANT_FIND_DISTMON, vbOKOnly, Title:=IDS_APP_NAME
Else
found = IsPDFWriterInstalled(PDFWriterName, Port)
If (found = 1) Then
EnsurePDFWriterIsInstalled = True
starPos = InStr(1, PDFWriterName, "*")
PDFWriterName = Left(PDFWriterName, starPos - 2)
starPos = InStr(1, Port, "*")
Port = Left(Port, starPos - 2)
End If
End If
If (Not EnsurePDFWriterIsInstalled) Then
MsgBox IDS_NO_PDFWRITER, vbOKOnly, Title:=IDS_APP_NAME
End If
End Function
Sub TogglePDFToolbar()
Dim Status As String
Dim NewStatus As String
Dim SaveStatus As String
On Error Resume Next
Status = GetPrivateProfileSetting(iniFilename, _
0, _
"Acrobat PDFWriter", _
IniPromptSetting)
If Status = "" Then Status = "Prompt"
If Status = "Prompt" Then
NewStatus = IDS_PDFWRITER_NO_PROMPT
SaveStatus = "Auto"
Else
NewStatus = IDS_PDFWRITER_PROMPT
SaveStatus = "Prompt"
End If
CommandBars("PDF").Controls.Item(2).Caption = NewStatus
CommandBars("PDF 4.0").Controls.Item(2).Caption = NewStatus
SetPrivateProfileSetting iniFilename, _
0, _
"Acrobat PDFWriter", _
IniPromptSetting, _
SaveStatus
ExitSub:
End Sub
Sub DetermineWhichApp()
bExcel = True
End Sub
Public Sub PrintPDFFile()
Dim Status As String
Dim outputFilename As String
Dim dotPos As Long
Dim prevDotPos As Long
Dim slashPos As Long
Dim saveCurrentPrinter As String
If (Application.Workbooks.Count = 0) Then
Exit Sub
End If
DetermineWhichApp
If Application.Sheets.Count = 0 Then Exit Sub
Dim printCurrentPageOnly As Boolean
printCurrentPageOnly = False
If (bWinNT) Then
SystemRoot$ = GetPrivateProfileSetting(BaseKey:=HKEY_LOCAL_MACHINE, _
Section:="Software\Microsoft\Windows NT\CurrentVersion", _
Setting:="SystemRoot")
iniFilename = SystemRoot$ + "\System32\Spool\Drivers\W32X86\"
If (bWinNT351) Then
iniFilename = iniFilename + "1\__pdf.ini"
Else
iniFilename = iniFilename + "2\__pdf.ini"
End If
Else
SystemRoot$ = GetPrivateProfileSetting(BaseKey:=HKEY_LOCAL_MACHINE, _
Section:="Software\Microsoft\Windows\CurrentVersion", _
Setting:="SystemRoot")
iniFilename = SystemRoot$ + "\System\PDFWritr.ini"
End If
' Make sure PDFWriter is installed
If EnsurePDFWriterIsInstalled(PDFWriterName, Port) = True Then
Status = GetPrivateProfileSetting(iniFilename, _
0, _
"Acrobat PDFWriter", _
IniPromptSetting)
If Status = "" Then Status = "Prompt"
' Build a full pathname to the output file
Set theDoc = Application.ActiveSheet()
outputFilename = theDoc.Parent.FullName ' Workbook owns the FullName
' Delete the extension (if any). Find the last period in the filename
dotPos = InStr(1, outputFilename, ".")
prevDotPos = dotPos
While dotPos > 1
dotPos = InStr(dotPos + 1, outputFilename, ".")
If dotPos > 1 Then prevDotPos = dotPos
Wend
If prevDotPos > 1 Then ' there's an extension
outputFilename = Left(outputFilename, prevDotPos) + "PDF"
Else ' no extension
outputFilename = outputFilename + ".PDF"
End If
' Make sure we have a folder path. If not, use wdTempFilePath
slashPos = InStr(1, outputFilename, "\")
If (slashPos = 0) Then
outputFilename$ = Application.DefaultFilePath + "\" + _
outputFilename
End If
' Tell PDFWriter to whether use this filename or prompt the user
If Status = "Prompt" Then
SetPrivateProfileSetting iniFilename, 0, _
"Acrobat PDFWriter", "PDFFileName", ""
Else
SetPrivateProfileSetting iniFilename, 0, _
"Acrobat PDFWriter", "PDFFileName", outputFilename
End If
Dim rangeVariant As Variant
' The different Office apps all have different ways of priting to
' a particular printer. Word lets you set the Application.ActivePrinter
' property. Excel's help file says you can do this, but you can't. But
' it allows you to specify the desired printer in the PrintOut method.
' PowerPoint doesn't do either of these, unfortunately.
' Set PDFWriter as the printer to use
saveCurrentPrinter = Application.ActivePrinter
On Error Resume Next
' Disallow background printing
' Don't append
' Page range
theDoc.PrintOut ActivePrinter:=PDFWriterName
SetPrivateProfileSetting iniFilename, 0, "Acrobat PDFWriter", "PDFFileName", ""
End If
End Sub
Sub AddOurMenuItem()
Dim fileMenu As CommandBar
Dim filePrintItem As CommandBarControl
Dim ourIndex
Dim createPDFItem
' This function adds the menu item 'Create Adobe PDF...' to the File menu
' Add our CommandBarControl
Set fileMenu = CommandBars(IDS_FILE_MENU_NAME)
'
' The Temporary:=True setting in Add doesn't seem to work; the menu
' item appears automatically the next time we run Word.
' So we need to determine if that menu item is already there.
' The FindControl method returns Nothing if the menu item isn't found,
' but there's no way to test for Nothing (the documented IsNothing method
' doesn't actually seem to exist). So we're forced to iterate through
' the File menu and use a boolean to determine if CreateAdobePDF is
' there already.
'
Dim fileMenuItem
Dim found
found = False
For Each fileMenuItem In fileMenu.Controls
If fileMenuItem.Tag = "CreateAdobePDF" Then
found = True
Exit For
End If
Next
If Not found Then
' Add the item to the File menu
Set filePrintItem = fileMenu.FindControl(Type:=msoControlButton, Id:=4, _
Recursive:=True)
ourIndex = filePrintItem.Index + 1
Set createPDFItem = fileMenu.Controls.Add(Type:=msoControlButton, _
Before:=ourIndex, Temporary:=True)
createPDFItem.Caption = IDS_FILE_MENU_ITEM
createPDFItem.OnAction = "PrintPDFFile"
createPDFItem.Tag = "CreateAdobePDF"
End If
End Sub
Sub AddOurToolbar()
Dim Status As String
Dim toolbarPrintButton As CommandBarButton
Dim toolbarToggleButton As CommandBarButton
Dim ourToolbar As CommandBar
' NOTE: This function must only be run by the macro developer at design time. It should be
' deleted from the shipping .xla file so that user's cannot run it.
' Before running it, you must:
' 1. Exit Excel 97.
' 2. Remove PDFWriter.xla from the XLStart directory.
' 3. Run Excel 97 and load PDFWriter.xls
' 4. Click Tools/Customize, select the PDF toolbar, and Delete it.
' Add the toolbar
On Error Resume Next
Set ourToolbar = CommandBars.Add(Name:=IDS_TOOLBAR_NAME, Position:=msoBarFloating)
ourToolbar.Visible = True
Set toolbarPrintButton = ourToolbar.Controls.Add(Type:=msoControlButton, Id:=1, Temporary:=False)
Set toolbarToggleButton = ourToolbar.Controls.Add(Type:=msoControlButton, Id:=1, Temporary:=False)
toolbarPrintButton.Move ' Move to the end of the toolbar
toolbarToggleButton.Move
With toolbarPrintButton
.Style = msoButtonIcon
.OnAction = "PrintPDFFile"
.TooltipText = IDS_TOOLTIP1_TEXT
.DescriptionText = IDS_STATUSBAR1_TEXT
.Caption = IDS_TOOLBAR_PRINT_BUTTON_CAPTION
.BeginGroup = True
' You need CopyIcon.dll and PDFTB.bmp, both in the Windows directory,
' or in the directory where Word and Excel are located, for this to
' work
Call CopyIconToClipboard
.PasteFace
End With
Status = GetPrivateProfileSetting(iniFilename, _
0, _
"Acrobat PDFWriter", _
IniPromptSetting)
If Status = "" Then Status = "Prompt"
SetPrivateProfileSetting iniFilename, 0, _
"Acrobat PDFWriter", "PDFFileName", ""
With toolbarToggleButton
.Style = msoButtonCaption
.OnAction = "TogglePDFToolbar"
.TooltipText = IDS_TOOLTIP2_TEXT
.DescriptionText = IDS_STATUSBAR2_TEXT
.Caption = Status
.Tag = "TogglePDF"
End With
TogglePDFToolbar ' Toggle twice to ensure the toolbar reflects
TogglePDFToolbar ' the ini file setting
End Sub
Sub Main()
On Error Resume Next
DetermineOSVersion
DetermineWhichApp
bDistMonOk = InitializeDistMon
' Delete the old toolbar
If (CommandBars("PDF").Name = "PDF") Then
CommandBars("PDF").Delete
End If
' Figure out where the system files are
If (bWinNT) Then
SystemRoot$ = GetPrivateProfileSetting(BaseKey:=HKEY_LOCAL_MACHINE, _
Section:="Software\Microsoft\Windows NT\CurrentVersion", _
Setting:="SystemRoot")
iniFilename = SystemRoot$ + "\System32\Spool\Drivers\W32X86\"
If (bWinNT351) Then
iniFilename = iniFilename + "1\__pdf.ini"
Else
iniFilename = iniFilename + "2\__pdf.ini"
End If
Else
SystemRoot$ = GetPrivateProfileSetting(BaseKey:=HKEY_LOCAL_MACHINE, _
Section:="Software\Microsoft\Windows\CurrentVersion", _
Setting:="SystemRoot")
iniFilename = SystemRoot$ + "\System\PDFWritr.ini"
End If
' The module containing this macro is called AutoExec. If the .dot file
' containing this module is placed in the Office Startup folder, the Main
' function of this module will be executed when an Office app is launched.
IniPromptSetting = "CreatePDFExcelMacroShowDialog"
' TogglePDFToolbar ' Toggle twice to ensure the toolbar reflects
' TogglePDFToolbar ' the ini file setting
End Sub
Sub Auto_Open()
Main
End Sub
Sub DetermineOSVersion()
Dim versionNum As Long
Dim temp As Long
bWin95 = False
bWinNT = False
bWinNT351 = False
bWinNT40 = False
nOSMajorVersion = 0
nOSMinorVersion = 0
versionNum = GetVersion()
If ((versionNum And &H80000000) = 0) Then
bWinNT = True
End If
bWin95 = Not bWinNT
nOSMajorVersion = versionNum And &HFF
temp = (versionNum - (versionNum And &HFFFF0000)) / 256
nOSMinorVersion = temp
If (bWinNT) Then
If (nOSMajorVersion = 4) Then bWinNT40 = True
If (nOSMajorVersion = 3) Then bWinNT351 = True
End If
AddOurMenuItem
End Sub
[Added code tags~VP]