View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson Greg Wilson is offline
external usenet poster
 
Posts: 747
Default Msgbox to make a choice

Michele,

Sorry for the late response but I was away for the evening.

I suggest that:
1) In column A of Sheet("Settings") starting in cell A1 you put all the
company names. I assume you have done this already.
2) In column B put the corresponding file names that you want to open - i.e.
If "Company A" is in cell A1 then "CompanyA.doc" should be in B1 if this is
the file to open if the user selects "Company A" etc.
3) Paste the updated version of the MakeUF macro (appended below) to a
separate module and delete the one I gave you earlier.
4) At the start of your macro substitute the following:

Const qfPath As String = "C:\Documents and Settings\John\My
Documents\quoteprogramfiles\"

Sub Quote()
Dim qfFileName As String
Call MakeUF 'get UserSelection value
If UserSelection = 0 Then Exit Sub
qfFileName = CompanyNmRng(UserSelection, 2) 'Get corresponding file name
'Quit if quote is open and open if not
If IsFileOpen(qfPath & qfFileName) Then
MsgBox "Quote form is open. Save and close form " & qfFileName & " and
try again."
Exit Sub
Else
Workbooks.Open qfPath & qfFileName
End If
'The rest of your code follows...

*Note that the IsFileOpen function causes me an error. Since I did not see a
reference to a UDF with this name in either yours or J.E.'s posts I assume
this is supported in later versions. Also note that the rest of your code
could be simplified in that it's seldom necessary to select anything.
However, if it works then it works. Good luck.

Regards,
Greg

'Replace the earlier version of MakeUF with this. Paste to a separate module.
Const UFColor As Single = 10040115
Public UserSelection As Integer
Public CompanyNmRng As Range

Sub MakeUF()
Dim UF As Object
Dim Ctrl As Object
Dim i As Integer
Dim Code As String

With Sheets("Settings")
Set CompanyNmRng = Range(.Range("A1"), .Range("A1").End(xlDown))
End With
Set UF = Application.VBE.ActiveVBProject.VBComponents.Add(3 )
UF.Properties("Width") = 170
UF.Properties("Caption") = "File selection"
With UF.Designer
Set Ctrl = .Controls.Add("Forms.Label.1")
With Ctrl
..Caption = "Select company..."
..ForeColor = UFColor
..Top = 5
..Left = 5
..Height = 15
..Width = 200
End With
For i = 1 To CompanyNmRng.Count
Set Ctrl = .Controls.Add("Forms.OptionButton.1")
With Ctrl
..Caption = CompanyNmRng(i, 1).Value
..ForeColor = UFColor
..Top = 20 + (i - 1) * 15
..Left = 5
..Height = 15
..Width = 150
..Value = (i = 1)
End With
Next
Set Ctrl = .Controls.Add("Forms.CommandButton.1")
With Ctrl
..Caption = "Apply"
..ForeColor = UFColor
..Top = 30 + (i - 1) * 15
..Left = 5
..Height = 20
..Width = 75
End With
Set Ctrl = .Controls.Add("Forms.CommandButton.1")
With Ctrl
..Caption = "Cancel"
..ForeColor = UFColor
..Top = 30 + (i - 1) * 15
..Left = 85
..Height = 20
..Width = 75
End With
End With

UF.Properties("Height") = Ctrl.Top + 45

Code = "Private Sub CommandButton1_Click()" & _
vbCrLf & "Dim i As Integer" & _
vbCrLf & "For i = 1 To Me.Controls.Count - 3" & _
vbCrLf & "If Me.Controls(i) = True Then" & _
vbCrLf & "UserSelection = i" & _
vbCrLf & "Exit For" & _
vbCrLf & "End If" & _
vbCrLf & "Next" & _
vbCrLf & "Unload Me" & _
vbCrLf & "End Sub" & _
vbCrLf & "Private Sub CommandButton2_Click()" & _
vbCrLf & "UserSelection = 0" & _
vbCrLf & "Unload Me" & _
vbCrLf & "End Sub"
UF.CodeModule.InsertLines 2, Code

VBA.UserForms.Add(UF.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove UF
End Sub