Solved: Remember last saved toolbar position

[TrippyTom]

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]

You could write an .ini file in the "C:\Program Files\Microsoft Office\OFFICE11\ADDINS" directory. Saveing the .Top, .Left, .Position, .RowIndex properties.

[TrippyTom]

That would be acceptable. Can you show me how to do this?

[Tommy]

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]

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]

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]

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]

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 without seeing the actual code

[TrippyTom]

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]

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]

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]

You are correct.

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

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

[TrippyTom]

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]

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]

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

[TrippyTom]

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]

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]

Eureka! Everything works now.
Thanks so much!!!

[TrippyTom]

Tommy,
Sorry to revive a solved post, but I have another question regarding this. I sent you an email through the forum.