Keep userform open when closing other workbooks

bj1280

New Member
Joined
Jan 17, 2019
Messages
12
Hi all, I have a userform that opens automatically and hides the workbook when I open the file. It all works perfect - and I have it as vbModeless in order that I can use excel for other things. Problem is, when I close the other workbooks, it also closes the userform and workbook that I want to keep open [Userform visible and workbook hidden). Try as I might, I can't find a solution - any ideas please from you bright people.
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,181
It may help to see your code that closes the workbooks.

This should close all the workbooks except the UserForm's workbook

Code:
    [color=darkblue]Dim[/color] wb [color=darkblue]As[/color] Workbook
    [color=darkblue]For[/color] [color=darkblue]Each[/color] wb [color=darkblue]In[/color] Application.Workbooks
        [color=darkblue]If[/color] [color=darkblue]Not[/color] wb [color=darkblue]Is[/color] ThisWorkbook [color=darkblue]Then[/color] wb.Close SaveChanges:=[color=darkblue]True[/color]
    [color=darkblue]Next[/color] wb
 

bj1280

New Member
Joined
Jan 17, 2019
Messages
12
Thanks AlphaFrog - here is the code from my project. This code only ever opens up the userform and hides the workbook, unless you click on edit that then prompts for a password to open up the workbook for editing. I want this open all day whilst I am working, but also need to open other unrelated excel sheet/workbooks. It's when I close them that it closes this one, or shows the open workbook behind the userform - something I don't want to happen. Hope you get my drift on this :)


Workbook Code
Code:
Private Sub Workbook_Open()
    Application.Visible = False
    Staff_Contacts.Show (vbModeless)
End Sub
Module code - I have other modules that deal with other things, but not to do with closing/hiding/showing workbooks
Code:
Sub HideWb()
    Application.Visible = False
    Staff_Contacts.Show (vbModeless)
End Sub
Userform Code
Code:
Option Explicit
Dim rData As Range


''//// This code puts the minimise maximise icons on the form but also stops other excel workbooks from closing


'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
'(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Private Declare Function GetWindowLongA Lib "user32" _
'(ByVal hWnd As Long, ByVal nIndex As Long) As Long
'Private Declare Function SetWindowLongA Lib "user32" _
'(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long


'Private Sub UserForm_Activate()
'Dim hWnd As Long, exLong As Long
'If Application.Version < 9 Then
'hWnd = FindWindow("ThunderXFrame", Me.Caption)
'Else
'hWnd = FindWindow("ThunderDFrame", Me.Caption)
'End If
'exLong = GetWindowLongA(hWnd, -16)
'If (exLong And &H30000) = 0 Then
'SetWindowLongA hWnd, -16, exLong Or &H20000
'Me.Hide: Me.Show
'End If
'End Sub




Private Sub cbAdd_Click()
        Unload Me
        UserForm1.Show
End Sub


Private Sub cbClear_Click()
    ClearAll Me
End Sub


Private Sub cbExit_Click()
    ThisWorkbook.Save
    Application.Quit
    Application.Visible = False
End Sub


Private Sub cboName_Change()
    Dim iX As Integer
    On Error Resume Next
    
    For iX = 1 To 5
        Me("TextBox" & iX + 4).Value = Me.cboName.List(Me.cboName.ListIndex, iX)
    
    Next iX
On Error GoTo 0
End Sub




Private Sub Frame1_Click()


End Sub


Private Sub ListBuilding_Click()
    Dim X As Integer


    On Error Resume Next
    X = ListBuilding.ListIndex + 1
    
    Me.ListStaff.List = Range("Staff" & X).Value
    On Error GoTo 0
    


End Sub


Private Sub ListStaff_Click()
    Dim rCl As Range
    On Error Resume Next
        Set rCl = rData.Columns(1).Find(Me.ListStaff.Value)


    With Me
        .tbxExt.Value = rCl.Offset(, 3).Value
        .TextBox2.Value = rCl.Offset(, 4).Value
        .TextBox3.Value = rCl.Offset(, 5).Value
        .TextBox4.Value = rCl.Offset(, 2).Value
    End With
    On Error GoTo 0
End Sub




Private Sub UserForm_Initialize()


    Set rData = Worksheets("Staff").Range("A2").CurrentRegion
    With Me
    
    .ListBuilding.List = rData.Offset(1, 0).Resize(rData.Rows.Count - 1, _
                                                     rData.Columns.Count).Value
   .ListBuilding.List = Range("Building").Value
   .cboName.List = rData.Value
End With
   ' HideTitleBar Me


End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)


    If CloseMode = vbFormControlMenu Then


        Cancel = True
       MsgBox "Please use the Quit PhoneBook button to close the Phone Book", vbOKOnly


    End If


End Sub
 

bj1280

New Member
Joined
Jan 17, 2019
Messages
12
Hey AlphaFrog, your code creates an error, - Compile Procedure: Invalid Outside Procedure

Any other suggestions :)
 

Forum statistics

Threads
1,084,748
Messages
5,379,613
Members
401,615
Latest member
syn_excel

Some videos you may like

This Week's Hot Topics

  • VBA code giving errors and stopping Excel
    Hello Experts, I have this code being used to loop through files in a file path, and copy specific data to another sheet. It is giving me several...
  • Disable MsgBox message
    Morning, I have a userform where if i leave a ComboBox empty i see a MsgBox warning me that i must enter an invoice number. It is this MsgBox i...
  • Macro Recorder into VBA, Copy Paste Data Filled Cells
    Hi Everyone, I have a macro recorder file that takes a selection of data, copies, then pastes into a new sheet on ("A2:B2") The issue is my...
  • Number format changes while pasting into a cell
    Hi, I am trying to paste a number 180204524303 from an email to an excel cell, however, whenever i try to do so , the the paste value appears as...
  • Collating data
    Hello all. Could someone please help. I am trying to pull all column data from multiple sheets (24 I total so far) into 1 master sheet without...
  • Sum Multiple Columns Based on Multiple Criteria
    I am trying to consolidate data by summing columns G through M based on material, plant, vendor, and fiscal year being identical. The period does...
Top