Code to position toolbar PLEASE help

slimimi

Well-known Member
Joined
May 27, 2008
Messages
532
Hi there - using excel 2003.

I have the following code to display a toolbar everytime my template is open

'Show Custom Toolbar "Trade Log" on Workbook Open
On Error Resume Next
With Application.CommandBars("Trade Log")
.Position = msoBarFloating
.Left = 5000
.Top = 600
.Visible = True
End With
End Sub

(hope i wrapped the code quotes correctly this time :)))))

I noticed that when you drag a custom toolbar to the far right of your screen - it locks in to a vertical toolbar space.

How can i position my toolbar in this place automatically by modifying the above code please?
 
Hi slimimi

With the userform in question (frmGetChartPics)
Is it possible to only open form (upon macro2button being clicked) IF there is an entry in Sheet1 : Range B & active cell row? IF no entry - msgbox"I can't look for Chart Pics unless you enter a Ticket/Trade Number" ?
Something like this in your normal module should work OK :
Code:
Sub macro2()
If Sheets("Sheet1").Range("B" & ActiveCell.Row) = "" Then
MsgBox "I can't look for Chart Pics unless you enter a Ticket/Trade Number"
Exit Sub
End If
frmGetChartPics.Show
End Sub

Also - i basically have 2 checkboxes on this form telling users what they need to have done before clicking the OK button to get Chart Pictures.
Is it possible to make the command OK button look to see if Both Checkboxes have been checked before proceeding? If not - msgbox"Please complete the above steps before Clicking OK"
That depends what your controls are called. In the example below I have CommandButton1, CheckBox1 and CheckBox2 - the check is fired when CommandButton1 is clicked :
Code:
Private Sub CommandButton1_Click()
If CheckBox1.Value = 0 Or CheckBox2.Value = 0 Then
MsgBox "Please complete the above steps before Clicking OK"
Exit Sub
End If
End Sub

HTH

DominicB
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Thank you dominic once again for all your help.

I need to just come back to the other code you gave me to autosave.


Code:
Const CSIDL_DESKTOP = &H0
Const MAX_PATH = 255
Private Type ****EMID
    cb As Long
    abID As Byte
    End Type
    Private Type ITEMIDLIST
    mkid As ****EMID
    End Type
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
 
Public Function GetSpecialfolder(CSIDL As Long) As String
Dim Res As Long
Dim IDL As ITEMIDLIST
Dim Path As String
Res = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If Res = 0 Then
Path = Space(512)
Res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
 
Sub SaveAndClose()
On Error Resume Next
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Trade Logs"
On Error GoTo 0
Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=GetSpecialfolder(CSIDL_DESKTOP) & "\Trade Logs\" & Sheets("Sheet3").Range("A1").Value
ActiveWorkbook.Close
End Sub</pre>
I am getting an error when i try to execute it.
I pasted it in the following place:

Private Sub cmdSAVElog_Click()

This is a command button on the userform : frmSAVElog

Sorry about this.

The error says:

Compile Error - Only comments may appear after End Property, etc etc
 
Upvote 0
Hi Dominic - its me again (sorry).

For some reason now - whenever i open the template - i am getting :

Run-time error 5
Invalid Procedure call or argument

When i click debug - it highlights this line of code that you gave me

With Application.CommandBars("Trade Log")

which was within this :

Code:
'Show Custom Toolbar "Trade Log" on Workbook Open
    With Application.CommandBars("Trade Log")
        .Position = msoBarRight
        .Top = 1000
        .Protection = msoBarNoMove
        .Visible = True
    End With
    Call DeleteTB
End Sub

Sigh.

Everything was working perfectly before thanks to all your help and i was about to go to bed really happy. Thought i would open it 1 more time to check everything and *it hit me*...

I have tried looking at it to figure out whats going on but cant make heads or tails of why it is suddenly causing this error.

Hope you can help me on this.
THanks in advance.
 
Upvote 0
Hi Dominic - how are you doing?
Sorry to trouble you.
I am having some issues with the Save Intercepts :(

I pasted this code in thisworkbook
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call BuildTB

'Intercept X Close command
Cancel = True
MsgBox "Please save your work first"
End Sub
 
'Intercept Save and SaveAs commands
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
MsgBox "Please use the Save Trade Log Button located at the bottom right of your screen"
End Sub

Now - if you remember - on the save Trade Log Macro form i have the following:

Code:
Private Sub cmdCANCELsavelog_Click()
'Cancels frmSAVElog
    Unload Me
End Sub

Private Sub cmdMODIFYtemplate_Click()
'Opens Password Checker which is frmPasswordSAVE
    frmPasswordSAVE.Show
    End Sub

Private Sub cmdSAVElog_Click()

End Sub

So - on the MODIFY option - the following userform pops up :
Code:
Private Sub cmdPASSok_Click()
    'Password Checker
    If Me.txtPASSWORD.Value <> "hundred" Then
        MsgBox "Incorrect Password", vbExclamation
        Me.txtPASSWORD.SetFocus
        Exit Sub
    End If
    If Me.txtPASSWORD.Value = "hundred" Then
    End If
    'Unloads Both Userforms
        Unload Me
        Unload frmSAVElog
    
    'Opens SaveAs Dialog Box
        Application.Dialogs(xlDialogSaveAs).Show
                                    
    End Sub

Private Sub CommandButton2_Click()
    Unload Me
    End Sub

Ok, the easy question first :)))
If password is incorrect - i have setfocus to the password box
But how can i also clear the 'old wrong password' too?
I thought that setfocus would do it.
Would it be a

Code:
me.txtPASSWORD.Clearseletion

or something like that?

Ok - to the hard bit now :__)

I done all the above. So now i have no way of saving which, so far, so good (cause we haven't implemented the save code yet).

So basically - i go to MODIFY and then type in the password "hundred" and then it brings me back to the

Code:
'Intercept Save and SaveAs commands code

This makes total sense.

You mentioned earlier that i should add the following line:

Code:
    'Opens SaveAs Dialog Box


Application.EnableEvents = False</pre>
Application.Dialogs(xlDialogSaveAs).Show
                                    
    End Sub

Ok - i have done this and it works fine. But the problem now is that when i re-open the template - all the intercepting code does not work anymore.

Hope you can help.
Thanks again.
 
Upvote 0
Hi Dominic
Can i trouble you with yet something else before i forget please?

Remember those MyMacro1 and MyMacro2 Toobars that you created for me?

Well - MyMacro1 (the Get Chart Pictures) button.
Is it possible to only allow this to be active on sheet 1?

So - if users go to Sheet 2 or Chart3 and press the button by mistake - a message box appears saying"You can only use this function on Sheet 1".

Would that be possible?

THanks in advance.
 
Upvote 0
Hi slimimi

Hope you had a nice weekend. Sorry, but not had time to look at your posts over the weekend.

So - if users go to Sheet 2 or Chart3 and press the button by mistake - a message box appears saying"You can only use this function on Sheet 1".

Sure. This one's quite simple. Stick something like this at the start of your Macro1 code - it will halt ecxecution with a message if the active sheet is not "Sheet1".

Code:
Sub MyMacro1()
If Not ActiveSheet.Name = "Sheet1" Then
MsgBox "You can only use this function on Sheet 1"
Exit Sub
End If
...
...
...
End Sub

I'm not sure where we're up to now, whether you've been able to sort out some of the above problems you mentioned. Perhaps a quick update?

HTH

DominicB
 
Upvote 0
Hi dominic - great to see you again.
I thought i might have scared you away with bombarding you with questions :)

Hope you had a great weekend - mine was cool but, as usual, not long enough. Imagine how great it would be if we could have 2 day weeks and 5 day weekends (ha ha).

Thanks for the recent code - i will apply it now.

Everything else is pretty much there already but i just cant get the save procedure to work. Remember - the intercepting the CLOSE, SAVE & SAVEAS calls but still making it possible to do a user save (as a workbook only) and a modify save (with password) so that template can be overwritten.

I tried what you suggested with inserting that extra line of code before the modify save procedure and that worked but problem was that when i reopen that file - there is no more intercepting the CLOSE, SAVE and SAVEAS routines.

Hope this all makes sense.
Please let me know if you need me to explain further.

Thanks again dominic.
BEST regards
 
Upvote 0
Hi dominic - that code was great - thank you.
I was wondering - i have alot of code now linked to the acutal name " " of my Sheet1.

Say, for example now i wanted to change the name of sheet 1 on the tab.
Is there an easy way to do this without causing complications to all the previous code?

Thanks in advance.
 
Upvote 0
Hi dominic - regarding this code that you sent me.
Const CSIDL_DESKTOP = &H0
Const MAX_PATH = 255
Private Type ****EMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ****EMID
End Type
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Function GetSpecialfolder(CSIDL As Long) As String
Dim Res As Long
Dim IDL As ITEMIDLIST
Dim Path As String
Res = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If Res = 0 Then
Path = Space(512)
Res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

Sub SaveAndClose()
On Error Resume Next
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Trade Logs"
On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetSpecialfolder(CSIDL_DESKTOP) & "\Trade Logs\" & Sheets("Sheet3").Range("A1").Value
ActiveWorkbook.Close
End Sub




i still haven't quite figured out where to paste it without getting errors.

Thanks alot
 
Upvote 0
Hi Dominic.
Just wanted to check to see if you got my last posts.
Hope all is well with you.
Thanks alot and hope to hear from you soon.
Kind Regards.
 
Upvote 0

Forum statistics

Threads
1,215,094
Messages
6,123,071
Members
449,092
Latest member
ipruravindra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top