PDA

View Full Version : Solved: Remember last saved toolbar position



TrippyTom
04-16-2007, 09:40 AM
How can I have my addin remember where the user placed the toolbar for the next time they start PowerPoint? Can this be done without making a COM or writing to the registry? (that's frowned upon here at work)

Tommy
04-16-2007, 10:28 AM
You could write an .ini file in the "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" directory. Saveing the .Top, .Left, .Position, .RowIndex properties.

TrippyTom
04-16-2007, 10:44 AM
That would be acceptable. Can you show me how to do this?

Tommy
04-16-2007, 12:16 PM
I found this here :http://www.freevbcode.com/ShowCode.asp?ID=5390

I modified the form code for a public function so all you should have to do is call these 2 functions with the modules included.


Sub SaveSettingIni(iToolBar As CommandBar)
With iToolBar
WriteIniValue "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", "Settings", "Position", CStr(.Position)
WriteIniValue "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", "Settings", "RowIndex", CStr(.RowIndex)
WriteIniValue "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", "Settings", "Left", CStr(.Left)
WriteIniValue "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", "Settings", "Top", CStr(.Top)
End With
End Sub

Sub WriteSettingIni(iToolBar As CommandBar)
With iToolBar
.Position = Val(ReadIniValue( "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", _
"Settings", "Position"))
.RowIndex = Val(ReadIniValue( "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", _
"Settings", "RowIndex"))
.Left = Val(ReadIniValue( _"C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", _
"Settings", "Left"))
.Top = Val(ReadIniValue( "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" & "\MyADDIN.ini", _
"Settings", "Top"))
End With
End Sub

Let me know if you need more help.

TrippyTom
04-16-2007, 04:16 PM
Hi Tommy,
I'm getting a "Sub or Function not defined" error when I try to compile the project - and it goes to the WriteIniValue line. Is this another sub I have to define? It doesn't seem native to PowerPoint.

Tommy
04-16-2007, 04:29 PM
That was in the modules in the zip file posted. I just modified their code from the link to maybe work for you.

This code goes in a module. It should work correct now. Sorry for the misunderstanding.

Option Explicit

Public Function WriteIniValue(INIpath As String, PutKey As String, PutVariable As String, PutValue As String)
Dim Temp As String
Dim LcaseTemp As String
Dim ReadKey As String
Dim ReadVariable As String
Dim LOKEY As Integer
Dim HIKEY As Integer
Dim KEYLEN As Integer
Dim VAR As Integer
Dim VARENDOFLINE As Integer
Dim NF As Integer
Dim X As Integer
AssignVariables:
NF = FreeFile
ReadKey = vbCrLf & "[" & LCase$(PutKey) & "]" & Chr$(13)
KEYLEN = Len(ReadKey)
ReadVariable = Chr$(10) & LCase$(PutVariable) & "="
EnsureFileExists:
Open INIpath For Binary As NF
Close NF
SetAttr INIpath, vbArchive
LoadFile:
Open INIpath For Input As NF
Temp = Input$(LOF(NF), NF)
Temp = vbCrLf & Temp & "[]"
Close NF
LcaseTemp = LCase$(Temp)
LogicMenu:
LOKEY = InStr(LcaseTemp, ReadKey)
If LOKEY = 0 Then GoTo AddKey:
HIKEY = InStr(LOKEY + KEYLEN, LcaseTemp, "[")
VAR = InStr(LOKEY, LcaseTemp, ReadVariable)
If VAR > HIKEY Or VAR < LOKEY Then GoTo AddVariable:
GoTo RenewVariable:
AddKey:
Temp = Left$(Temp, Len(Temp) - 2)
Temp = Temp & vbCrLf & vbCrLf & "[" & PutKey & "]" & vbCrLf & PutVariable & "=" & PutValue
GoTo TrimFinalString:
AddVariable:
Temp = Left$(Temp, Len(Temp) - 2)
Temp = Left$(Temp, LOKEY + KEYLEN) & PutVariable & "=" & PutValue & vbCrLf & Mid$(Temp, LOKEY + KEYLEN + 1)
GoTo TrimFinalString:
RenewVariable:
Temp = Left$(Temp, Len(Temp) - 2)
VARENDOFLINE = InStr(VAR, Temp, Chr$(13))
Temp = Left$(Temp, VAR) & PutVariable & "=" & PutValue & Mid$(Temp, VARENDOFLINE)
GoTo TrimFinalString:
TrimFinalString:
Temp = Mid$(Temp, 2)
Do Until InStr(Temp, vbCrLf & vbCrLf & vbCrLf) = 0
Temp = Replace(Temp, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
Loop
Do Until Right$(Temp, 1) > Chr$(13)
Temp = Left$(Temp, Len(Temp) - 1)
Loop
Do Until Left$(Temp, 1) > Chr$(13)
Temp = Mid$(Temp, 2)
Loop
OutputAmendedINIFile:
Open INIpath For Output As NF
Print #NF, Temp
Close NF
End Function

Public Function ReadIniValue(INIpath As String, KEY As String, Variable As String) As String
Dim NF As Integer
Dim Temp As String
Dim LcaseTemp As String
Dim ReadyToRead As Boolean
AssignVariables:
NF = FreeFile
ReadIniValue = ""
KEY = "[" & LCase$(KEY) & "]"
Variable = LCase$(Variable)
EnsureFileExists:
Open INIpath For Binary As NF
Close NF
SetAttr INIpath, vbArchive
LoadFile:
Open INIpath For Input As NF
While Not EOF(NF)
Line Input #NF, Temp
LcaseTemp = LCase$(Temp)
If InStr(LcaseTemp, "[") <> 0 Then ReadyToRead = False
If LcaseTemp = KEY Then ReadyToRead = True
If InStr(LcaseTemp, "[") = 0 And ReadyToRead = True Then
If InStr(LcaseTemp, Variable & "=") = 1 Then
ReadIniValue = Mid$(Temp, 1 + Len(Variable & "="))
Close NF: Exit Function
End If
End If
Wend
Close NF
End Function

TrippyTom
04-16-2007, 05:05 PM
strange...
This works for me as a normal macro, but when I try to use this in my addin, the toolbar keeps popping up below and to the right of where it was previously. I think it has something to do with the fact my code deletes and recreates the toolbar if it already exists.

I will have to look into this further, but this code is really daunting for someone with my lack of experience. I looked at the zip file, but it had an EXE file in there and that scared me off.

Thanks for pointing me in the right direction. :)

Tommy
04-16-2007, 06:47 PM
strange...
This works for me as a normal macro, but when I try to use this in my addin, the toolbar keeps popping up below and to the right of where it was previously. I think it has something to do with the fact my code deletes and recreates the toolbar if it already exists.

I will have to look into this further, but this code is really daunting for someone with my lack of experience. I looked at the zip file, but it had an EXE file in there and that scared me off.

Thanks for pointing me in the right direction. :)
Sorry about the exe I just looked at the code. If you are only setting the position on creation and saving the position on deletion that "shouldn't" be the problem. Make sure you are setting the position after the .CommandBars.Add :dunno without seeing the actual code

TrippyTom
04-17-2007, 09:31 AM
It should be in the open and close procedures, right? Like this:


Sub Auto_Open()
Dim myPlacement As CommandBar
createMyBar
WriteSettingIni (myPlacement)
End Sub

Sub Auto_Close()
Dim myPlacement As CommandBar
SaveSettingIni (myPlacement)
deleteMyBar
End Sub


I think I have something wrong here

Tommy
04-17-2007, 11:18 AM
The first thing I see is you are not creating (in your sample) a toolbar. I kow you are calling a sub to do this it is just you are not passing the "toolbar" back to the sub in the autoopen.

This is my "blank"/Template for creating toolbars. It works in Word, Excel, Acad, and in the VB IDE. I normally use the regestry, I removed that code and replaced it with the ini.


Option Explicit
Public Const YOUR_TOOLBAR_NAME As String = "A Name For Your ToolBar"
Public MyButton As CommandBarButton
Public MyButton1 As CommandBarButton
Public MyButton2 As CommandBarButton
Public Sub AddToolBar()
On Error Resume Next
Dim I As Integer
Dim J As Integer
Dim sToolBar As String
On Error Resume Next
sToolBar = Application.CommandBars(YOUR_TOOLBAR_NAME).Name
If Err.Number <> 0 Then
Application.CommandBars.Add YOUR_TOOLBAR_NAME, , , True
WriteSettingIni (YOUR_TOOLBAR_NAME)
End If
Application.CommandBars(YOUR_TOOLBAR_NAME).Visible = True
I = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(YOUR_TOOLBAR_NAME).Controls(J).Delete
Next
On Error GoTo 0
If MyButton Is Nothing Then
Set MyButton = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton
.Caption = "A Name For Your Button"
.Style = msoButtonIconAndCaption 'icon and caption
'.Style = msoButtonCaption 'caption only
'.Style = msoButtonIcon 'icon only
.Tag = "VBA CustomButtons"
.OnAction = "Macro.1"
.FaceId = 362 'standard ms face icons
.Visible = True
End With
If MyButton1 Is Nothing Then
Set MyButton1 = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton1
.Caption = "Another Name For Your Button"
.Style = msoButtonIconAndCaption
.Tag = "VBA CustomButton1"
.OnAction = "MacroB"
.FaceId = 3732
.Visible = True
End With
If MyButton2 Is Nothing Then
Set MyButton2 = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton2
.Caption = "And Yet Another Name For Your Button"
.Style = msoButtonIconAndCaption
.Tag = "VBA CustomButton2"
.OnAction = "Macro3"
.FaceId = 3732
.Visible = True
End With
End Sub

Public Sub DeleteToolBar()
Dim I As Integer
Dim J As Integer
On Error Resume Next
SaveSettingIni (YOUR_TOOLBAR_NAME)
I = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(YOUR_TOOLBAR_NAME).Controls(J).Delete
Next
Set MyButton = Nothing
Set MyButton1 = Nothing
Application.CommandBars(YOUR_TOOLBAR_NAME).Delete
Set RghtHer = Nothing
On Error GoTo 0
End Sub

Sub SetLocation(BarName As String)
Dim lToolbarPosition As Long
Dim lToolbarIndex As Long
Dim lToolbarTop As Long
Dim lToolbarLeft As Long
lToolbarPosition = CLng(GetSetting(YOUR_TOOLBAR_NAME, "Settings", "ToolbarPosition", CStr(msoBarTop)))
lToolbarIndex = CLng(GetSetting(YOUR_TOOLBAR_NAME, "Settings", "ToolbarIndex", "0"))
lToolbarLeft = CLng(GetSetting(YOUR_TOOLBAR_NAME, "Settings", "ToolbarLeft", "0"))
lToolbarTop = CLng(GetSetting(YOUR_TOOLBAR_NAME, "Settings", "ToolbarTop", "0"))
With Application.CommandBars(YOUR_TOOLBAR_NAME)
.Position = lToolbarPosition
Select Case lToolbarPosition
Case msoBarTop, msoBarBottom
.RowIndex = lToolbarIndex
.Left = lToolbarLeft
Case msoBarLeft, msoBarRight
.RowIndex = lToolbarIndex
.Top = lToolbarTop
Case Else
.Top = lToolbarTop
.Left = lToolbarLeft
End Select
.Visible = True
End With
End Sub

TrippyTom
04-17-2007, 02:08 PM
Hi Tommy,

I really appreciate you trying to help me with this. I'm feeling like a dunce now because when I try to compile the project, I get a "Type Mismatch" error on this line in the code that adds the toolbar:


WriteSettingIni (YOUR_TOOLBAR_NAME)


I set the constant at the beginning to the name of my toolbar, but I think what's happening is the function is not expecting a string. How would I fix this?

Tommy
04-17-2007, 03:53 PM
You are correct. :mkay

The problem will also show up in the SaveSettingIni .

change:

WriteSettingIni (YOUR_TOOLBAR_NAME)
to:

WriteSettingIni (Application.CommandBars(YOUR_TOOLBAR_NAME))

change:

SaveSettingIni (YOUR_TOOLBAR_NAME)

to:

SaveSettingIni (Application.CommandBars(YOUR_TOOLBAR_NAME))

BTW I have changed the subs to:


Sub SaveSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "C:\Program Files\Microsoft Office\OFFICE11\ADDINS\"
With iToolBar
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Position", _
CStr(.Position)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "RowIndex", _
CStr(.RowIndex)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Left", CStr(.Left)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Top", CStr(.Top)
End With
End Sub

Sub ReadSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "C:\Program Files\Microsoft Office\OFFICE11\ADDINS\"
With iToolBar
.Position = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", _
"Position"))
.RowIndex = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", _
"RowIndex"))
.Left = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "Left"))
.Top = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "Top"))
End With
End Sub


:doh: it may make more sense now. So change WriteSettingIni to ReadSettingIni and you should be up and running! :yes

TrippyTom
04-17-2007, 04:24 PM
Tommy, will it not allow me to write to a specific drive? At work, our personal drives are I:\, so I changed it to my needs (below) but it doesn't seem to be writing a myPlacement.ini file at all.


Sub SaveSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "I:\"
With iToolBar
WriteIniValue DirLoc & "myPlacement.ini", "Settings", "Position", _
CStr(.Position)
WriteIniValue DirLoc & "myPlacement.ini", "Settings", "RowIndex", _
CStr(.RowIndex)
WriteIniValue DirLoc & "myPlacement.ini", "Settings", "Left", CStr(.Left)
WriteIniValue DirLoc & "myPlacement.ini", "Settings", "Top", CStr(.Top)
End With
End Sub

Sub ReadSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "I:\"
With iToolBar
.Position = Val(ReadIniValue(DirLoc & "myPlacement.ini", "Settings", "Position"))
.RowIndex = Val(ReadIniValue(DirLoc & "myPlacement.ini", "Settings", "RowIndex"))
.Left = Val(ReadIniValue(DirLoc & "myPlacement.ini", "Settings", "Left"))
.Top = Val(ReadIniValue(DirLoc & "myPlacement.ini", "Settings", "Top"))
End With
End Sub

Tommy
04-17-2007, 04:49 PM
I bet you don't have root access. just a guess. Try "C:\". If this works it is the drive you don't have access rights to.

TrippyTom
04-17-2007, 04:53 PM
Very strange, it doesn't save to C:\ either. Does the platform we're on matter?
Office 2003 - SP2, Windows 2000 - SP4

TrippyTom
04-17-2007, 05:11 PM
I found another example that writes to a .txt file and this works for me:


Sub TextOut()
Dim FileNum As Variant
FileNum = FreeFile
Open "C:/" & "NotesText2.TXT" For Output As FileNum
Print #FileNum, "This is the text to save"
Close FileNum
End Sub


I thought maybe my \ / marks were backwards, so I tried using "/" instead and it didn't seem to matter. Can I use a form of this subroutine to get the variables written to a file?

Tommy
04-18-2007, 06:22 AM
I tested this one here. It writes to and reads from correctly. I had something wrong I think it was the way I called the sub, it thought I was still writting to the regestry.



Option Explicit
Public Const YOUR_TOOLBAR_NAME As String = "A Name For Your ToolBar"
Public MyButton As CommandBarButton

Sub SaveSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "I:\"
With iToolBar
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Position", CStr(.Position)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "RowIndex", CStr(.RowIndex)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Left", CStr(.Left)
WriteIniValue DirLoc & "MyADDIN.ini", "Settings", "Top", CStr(.Top)
End With
End Sub

Sub ReadSettingIni(iToolBar As CommandBar)
Dim DirLoc As String
DirLoc = "I:\"
With iToolBar
.Position = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "Position"))
.RowIndex = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "RowIndex"))
.Left = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "Left"))
.Top = Val(ReadIniValue(DirLoc & "MyADDIN.ini", "Settings", "Top"))
End With
End Sub

Public Sub AddToolBar()
On Error Resume Next
Dim I As Integer
Dim J As Integer
Dim sToolBar As String
On Error Resume Next
sToolBar = Application.CommandBars(YOUR_TOOLBAR_NAME).Name
If Err.Number <> 0 Then
Application.CommandBars.Add YOUR_TOOLBAR_NAME, , , True
ReadSettingIni Application.CommandBars(YOUR_TOOLBAR_NAME) '<- this line
End If
Application.CommandBars(YOUR_TOOLBAR_NAME).Visible = True
I = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(YOUR_TOOLBAR_NAME).Controls(J).Delete
Next
On Error GoTo 0
If MyButton Is Nothing Then
Set MyButton = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton
.Caption = "A Name For Your Button"
.Style = msoButtonIconAndCaption 'icon and caption
'.Style = msoButtonCaption 'caption only
'.Style = msoButtonIcon 'icon only
.Tag = "VBA CustomButtons"
.OnAction = "Macro.1"
.FaceId = 362 'standard ms face icons
.Visible = True
End With
End Sub

Public Sub DeleteToolBar()
Dim I As Integer
Dim J As Integer
On Error Resume Next
SaveSettingIni Application.CommandBars(YOUR_TOOLBAR_NAME) '<- this line
I = Application.CommandBars(YOUR_TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(YOUR_TOOLBAR_NAME).Controls(J).Delete
Next
Set MyButton = Nothing
Application.CommandBars(YOUR_TOOLBAR_NAME).Delete
On Error GoTo 0
End Sub

TrippyTom
04-18-2007, 01:09 PM
Eureka! Everything works now.
Thanks so much!!!
:bow:

TrippyTom
03-17-2008, 09:45 AM
Tommy,
Sorry to revive a solved post, but I have another question regarding this. I sent you an email through the forum.