Posts by max_lux

max_lux · Jan 23rd 2006

I have found all the code that will change an entire row or column to a highlighted color, but this doesn't seem to work on a protected sheet if you have cells in the area that is protected.
What I would like to do, therefore, is simply have the adjacent cell in column A highlighted if anywhere in the row is selected.

Is this possible with a protected sheet? And if so, ideas?

I have attached a sheet to demonstrate what I want - if I am working
in cell H13, I would like cell A13 to be highlighted,
in cell H21, I would like cell A21 to be highlighted,
etc. etc.

All gey cells are/ would be protected.

max_lux · Jan 23rd 2006

Re: Commandbars (Toolbars) Restore Workbook

Here's the code. If anyone has something to add, then feel free...

Code

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
      ByVal bRevert As Integer) As Integer


Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
      ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Sub Close_()


    Dim cb As CommandBar 'enable commandbars
        For Each cb In CommandBars
        If cb.Type = msoBarTypePopup Then cb.Enabled = True
    Next cb
On Error GoTo next1


   Dim rcmenu As Integer 'enable right click menu commands
   For rcmenu = 1 To 9
    Call DeleteMenu(GetSystemMenu(Application.hwnd, True), 0, 1024)
   Next rcmenu
   
next1:
On Error GoTo next2
    CommandBars("Toolbar List").Enabled = True 'enable toolbar list
    Application.CommandBars("Worksheet Menu Bar").Enabled = True 'enable file menu
    Application.CommandBars.DisableCustomize = False 'enable customize
    CommandBars(27).Enabled = True ' enable worksheet tabs right click


    Application.CommandBars("Standard").Visible = True 'show standard
    Application.CommandBars("Formatting").Visible = True 'show standard
    Application.DisplayStatusBar = True 'show standard
next2:
    
End Sub


Sub App_Quit()
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
End Sub

Display More

max_lux · Jan 23rd 2006

Hi,

Because I made a workbook which has all commandbars removed, I thought it might be prudent to make a workbook which would restore all standard Excel commandbars, right click, workbook tabs right click,... well, you get the idea. This workbook restores anything that can be disabled with code, back to a state that 99% of users are used to.

I distribute this with my workbook, and the user can therefore simply open this if they have an Excel crash, rather than phoning me. When the user opens this workbook, it restores everything, and then the user simply clicks an "Ok" button to close the workbook. This makes it easy to use, even for the novice user.

The worksheet is protected with no password. The VBA project is not protected.

Feel free to distribute this with your workbooks if you like. I ask you to please not modify the original content. Protect it as you wish.

Kind regards,

Please stand-by - I am editing the code - I found one thing I had not been able to restore with this - i will, also, post the code for this prior to uploading it again.

max_lux · Jan 23rd 2006

Re: Custom Commandbar - Buttons On Commandbar

So far the only thing that doesn't cause an error is:

Code

Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=113, Before:=10) ' bold
cbcCustomMenu.BeginGroup = True

This does:

Code

With cbcCustomMenu = cMenu1.BeginGroup = True
End With

as does this:

Code

With cbcCustomMenu = cMenu1.Controls.Add()
        .BeginGroup = True
End With

as does this:

Code

With cbcCustomMenu = cMenu1.Controls
        .BeginGroup = True
End With

as does this:

Code

With cbcCustomMenu = cMenu1.Controls.Add(Type:=msoBarTypeMenuBar)
        .BeginGroup = True
End With

as does eveything I try. I know the property can be set, but I can't find an argument to do it... The macro recorder does not record changing this property either...

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

Ok here is how Nory helped me - he made my original code into an array code. For the purposes of this forum, the File menu will be shown.

Norie's code:

Code

Sub AddMenus()
    Dim cMenu1 As CommandBarControl
    Dim cMenu2 As CommandBarComboBox
    Dim cbMainMenuBar As CommandBar
    Dim iHelpMenu As Integer
    Dim cbcCustomMenu As CommandBarControl
    Dim arrCaptions
    Dim arrFaceID
    Dim arrOnAction
    Dim arrBeginGroup
    Dim I As Long


    On Error Resume Next


    Set cbMainMenuBar = Application.CommandBars.Add("CamCustom")


foundFlag = False
For Each cb In CommandBars
    If cb.Name = "CamCustom" Then
        cb.Visible = True
        cb.Position = msoBarTop
        cb.Protection = msoBarNoChangeDock
        foundFlag = True
    End If
Next cb
If Not foundFlag Then
    MsgBox "There is an error with the command bar. Please restart the application."
End If


     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ WELL FILE MENU
    Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlPopup)
    cMenu1.Caption = "Well &File"


    arrCaptions = Array("&New File Ctrl+N", "New Lost &Inventory Report", _
    "Monday &Report", "&Save Ctrl+S", "Save &As... Shft+Ctrl+A", _
    "&Print Main Report Ctrl+P", "Pre&view Main Report", _
    "Print/ Export/ E&mail Main Report Ctrl+M", _
    "&Export/ Email Main Report Ctrl+E", "Print &Info Collection Sheet", _
    "E&xit")


    arrFaceID = Array(32, 372, 7, 3, 1, 4, 1446, 1, 1, 4, 478)


    arrOnAction = Array("Open_New_Book", "Open_New_LIM", "Go_To_Mon", "Save_Current", _
    "Save_As", "Print_Main", "Prev_main", "Print_Export_Main", _
    "Export_main", "Print_Info", "close_all")


    arrBeginGroup = Array(False, False, False, True, False, True, False, False, False, True, True)


    For I = LBound(arrCaptions) To UBound(arrCaptions)
        Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
        With cbcCustomMenu
            .Caption = arrCaptions(I)
            .FaceId = arrFaceID(I)
            .OnAction = arrOnAction(I)
            .BeginGroup = arrBeginGroup(I)
        End With
    Next I


    cbMainMenuBar.Visible = True


End Sub
 
Sub DeleteMenu()
    On Error Resume Next
    Application.CommandBars("CamCustom").Delete
    On Error GoTo 0
End Sub

Display More

My original code:

Code

Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cMenu2 As CommandBarComboBox
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCustomMenu As CommandBarControl


On Error GoTo resumetask
Application.CommandBars("CamCustom").Delete
resumetask:


Set cbMainMenuBar = Application.CommandBars.Add("CamCustom")


foundFlag = False
For Each cb In CommandBars
    If cb.Name = "CamCustom" Then
        cb.Visible = True
        cb.Position = msoBarTop
        cb.Protection = msoBarNoChangeDock
        foundFlag = True
    End If
Next cb
If Not foundFlag Then
    MsgBox "There is an error with the command bar. Please restart the application."
End If


On Error Resume Next
    Application.CommandBars("CamCustom").Controls("&Well File").Delete
On Error GoTo 0
 Set cbMainMenuBar = Application.CommandBars("CamCustom")








'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ WELL FILE MENU
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlPopup)
    cMenu1.Caption = "&File"


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
        With cbcCustomMenu
        .Caption = "&New New File                                            Ctrl+N"
        .FaceId = 32
        .OnAction = "Open_New_Book"
        .BeginGroup = False
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
        With cbcCustomMenu
        .Caption = "New Lost &Inventory Report"
        .FaceId = 372
        .OnAction = "Open_New_LIM"
        .BeginGroup = False
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
        With cbcCustomMenu
        .Caption = "Monday &Report"
        .FaceId = 7
        .OnAction = "Go_To_Mon"
        .BeginGroup = False
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
        With cbcCustomMenu
        .Caption = "&Save                                                         Ctrl+S"
        .FaceId = 3
        .OnAction = "Save_Current"
        .BeginGroup = True
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "Save &As...                                      Shft+Ctrl+A"
        .FaceId = 1
        .OnAction = "Save_As"
        .BeginGroup = False
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "&Print Main Report                                      Ctrl+P"
        .FaceId = 4
        .OnAction = "Print_Main"
        .BeginGroup = True
    End With
        Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "Pre&view Main Report"
        .FaceId = 1446
        .OnAction = "Prev_main"
        .BeginGroup = False
    End With




        Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "Print/ Export/ E&mail Main Report              Ctrl+M"
        .FaceId = 1
        .OnAction = "Print_Export_Main"
        .BeginGroup = False
    End With


        Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "&Export/ Email Main Report                        Ctrl+E"
        .FaceId = 1
        .OnAction = "Export_main"
        .BeginGroup = False
    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "Print &Info Collection Sheet"
        .FaceId = 4
        .OnAction = "Print_Info_Collect"
        .BeginGroup = True
    End With




'    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
'    With cbcCustomMenu
'        .Caption = "&Close"
'        .FaceId = 1
'        .OnAction = "App_Close"
'        .BeginGroup = True
'    End With


    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "E&xit"
        .FaceId = 478
        .OnAction = "Close_All"
        .BeginGroup = True
    End With


Sub DeleteMenu()
    On Error Resume Next
    Application.CommandBars("CamCustom").Controls("&Well File").Delete
    On Error GoTo 0
End Sub

Display More

Now, back to something, anyone know how to begin group on a commandbar so it looks like:
*() simulates button

File Edit View Window Help |<begin group> (Bold)(Underline) |<begin group> (Align Left)

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

I'd prefer to not post the entire code... all I need at this point is a way to begin a group for the above code. Everything else I have sorted...

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

lol surely it can be that long. Here's my popup list:

Code

On Error Resume Next
    Application.CommandBars("CamCustom").Controls("&File").Delete
    Application.CommandBars("CamCustom").Controls("&Edit").Delete
    Application.CommandBars("CamCustom").Controls("&View").Delete
    Application.CommandBars("CamCustom").Controls("&Tools").Delete
'    Application.CommandBars("CamCustom").Controls("&Window").Delete
    Application.CommandBars("CamCustom").Controls("&Navigation").Delete
    Application.CommandBars("CamCustom").Controls("&Inventory").Delete
    Application.CommandBars("CamCustom").Controls("&Tickets").Delete
    Application.CommandBars("CamCustom").Controls("End &Reports").Delete
    Application.CommandBars("CamCustom").Controls("&Help").Delete
    Application.CommandBars("CamCustom").Controls(5).Delete
    Application.CommandBars("CamCustom").Controls(4).Delete
    Application.CommandBars("CamCustom").Controls(3).Delete
    Application.CommandBars("CamCustom").Controls(2).Delete
    Application.CommandBars("CamCustom").Controls(1).Delete
On Error GoTo 0
 Set cbMainMenuBar = Application.CommandBars("CamCustom")

Display More

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

here is my button code, and the button delete code - i found that i had to order the button numbers backward to delete the buttons, otherwise it left 1 or 2.

Code

'~~ SYSTEM BUTTONS ~~
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=113, Before:=10)'bold
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=115, Before:=11)'underline
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=120, Before:=12)'align left
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=122, Before:=13)'center
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=121, Before:=14)'align right
End Sub
Sub DeleteMenu() ' left applicable code
    On Error Resume Next
    Application.CommandBars("CamCustom").Controls(5).Delete
    Application.CommandBars("CamCustom").Controls(4).Delete
    Application.CommandBars("CamCustom").Controls(3).Delete
    Application.CommandBars("CamCustom").Controls(2).Delete
    Application.CommandBars("CamCustom").Controls(1).Delete
    On Error GoTo 0
End Sub

Display More

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

for the whole toolbar? it is 967 lines...

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

Quote from norie

Max

To begin a group use the BeginGroup property.

Just delete the toolbar, or set their Tag property and use FindControl.

I've tried setting this, but to no avail. Any suggestions?

Thanks, btw, you are helpful as always :thanx:

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

Again, got it, hehe

Code

Application.CommandBars("CamCustom").Controls(1).Delete
    Application.CommandBars("CamCustom").Controls(2).Delete

which leaves me with just one question... How to begin a group with the bold button?

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

and... hehe, how to I delete them upon rebuild and deactivate, close, etc.?

max_lux · Jan 22nd 2006

Re: Custom Commandbar - Buttons On Commandbar

Got adding them...

Code

Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=113)
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton, ID:=115)

Now I need to figure out how to have them start a group. Is that possible?

max_lux · Jan 22nd 2006

Hi, I have a commandbar question. First I shall describe what I am trying to do, which will best serve to convey what I am trying to do.

I have made a custom commandbar for my workbook, which is built and deleted at open/ close. In this workbook, I have one sheet where I wish the user to be able to use bold and underline, but I do not want to allow access to the formatting commandbar. I could add a "Format" control popup to my custom commandbar, and use macros to achieve the effect, but I would prefer to use toggling system buttons at the end of my commandbar to the right of the help menu.

Is there possibly any way to do this?

I know the commandbar IDs of the buttons, and have tried various attempts at both making them appear/ work. I can get an invisible button to show up, but no face is seen and no function is completed when pressing it. Since I am unable to assign a FaceID or other otions to a controlpopup, that is out of the question.
FaceIDs are:
Bold= 113
Underline= 115

Here is the code, beginning with just before the help menu, and ending with my most successful, yet inadequate remmed out attempt at doing this. If you know how I could do this, I would appreciate your help, and thank-you very much for your help.

Kind regards,

Code

With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
        .Caption = "&Print"
        .FaceId = 4
        .OnAction = "Print_MudProperties"
        .BeginGroup = False
    End With


'~~ HELP MENU ~~
Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlPopup) ', Before:=iHelpMenu)
    cMenu1.Caption = "&Help"
    
    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlButton)
    With cbcCustomMenu
        .Caption = "&Show Dweeb Assistant"
        .FaceId = 1
        .OnAction = "bla_bla"
        .BeginGroup = False
    End With


'~~ Bold and Underline Buttons ~~
'Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlButton)
'    cMenu1.Controls.Add ID:=113
End Sub

Display More

max_lux · Jan 22nd 2006

Re: Sub Sub Menu

Thanks Bob

One more question, if I may?

How would I add actual system menu items (coded), such as Zoom, so it would be available?

I have completely disabled the worksheet menubar and have my own complete toolbar.

max_lux · Jan 21st 2006

I am building a toolbar, and I would like to organize some report navigation as follows:

&Reports
_______&End Project
__________________Page &1
_________________________&Edit
_________________________Pre&view
_________________________&Print
etc.

Here is my code:

Code

Set cMenu1 = cbMainMenuBar.Controls.Add(Type:=msoControlPopup) ', Before:=iHelpMenu)'< MENU HEADER
    cMenu1.Caption = "&Reports" '< MENU HEADER CAPTION
    
    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlPopup) ' <SUB MENU HEADER
    cbcCustomMenu.Caption = "&End Project" ' <SUB MENU HEADER CAPTION
    
    Set cbcCustomMenu = cMenu1.Controls.Add(Type:=msoControlPopup) ' <SUB MENU HEADER
    cbcCustomMenu.Caption = "Page &1" ' <SUB MENU HEADER CAPTION


    With cbcCustomMenu.Controls.Add(Type:=msoControlButton) '<BUTTON
        .Caption = "&Edit"
        .FaceId = 31
        .OnAction = ""
        .BeginGroup = False
    End With
    
    With cbcCustomMenu.Controls.Add(Type:=msoControlButton) '<BUTTON
        .Caption = "Pre&view"
        .FaceId = 1446
        .OnAction = ""
        .BeginGroup = False
    End With


    With cbcCustomMenu.Controls.Add(Type:=msoControlButton) '<BUTTON
        .Caption = "&Print"
        .FaceId = 4
        .OnAction = ""
        .BeginGroup = False
    End With
End Sub

Display More

What I end up with with this code is:

&Reports
_______&End Project
_______Page &1
______________&Edit
______________Pre&view
______________&Print
etc.

Is there any way to do this?

Thanks in advance

max_lux · Jan 20th 2006

Re: Email /Routing Copied Sheet

here's an example workbook

max_lux · Jan 20th 2006

Re: Dim Variable

and to declare them public, one types?

public dim str as string

max_lux · Jan 20th 2006

Re: Multiple timers (stopwatches) in one worksheet

I use multiple timers, objects that i move forward/ backward to indicate they are running, a bell that goes off, a message that appears when the bell goes off, and it selects the cell on the applicable sheet when user clicks ok. This works whether minimized/ on another sheet/ in another book, etc.

Code

Sub Timer_1sec_Test() '1 Second Test
Application.OnTime Now + TimeValue("00:00:01"), "Timer_1sec_Test_Elapsed"
End Sub
Sub Timer_1sec_Test_elapsed() '1 Second Test Elapsed
Sheets("sheet1").Select
ActiveSheet.Unprotect Password:="___"
ActiveSheet.Shapes("Object 43").Select '< bell sound object
Selection.Verb Verb:=xlPrimary
Dim Msg, Style, Title, Response, MyString
Msg = "Test Complete!"
Style = vbOKOnly + vbMsgBoxSetForeground + vbInformation
Title = "Test Alarm"
Response = MsgBox(Msg, Style, Title)
If Response = vbOK Then
Else
End If
Range("F5").Select
ActiveSheet.Protect Password:="___"
End Sub

Display More

max_lux · Jan 19th 2006

Re: Modify Print Preview Options

Theres a way to grey out a couple buttons in print preview, but they ungrey when one selects close. In short, I have searched these forums and on the net for weeks and haven't found anything that will do that.