Antwort von
nach 5 Tagen
hilfreich
Re: [VBA-Excel]eigene Symbole für eigene Symbollei
Hallo,
habe ein Word97-VBA-Coding, das im Menü unter Datei einen Eintrag "Bilder erfassen..." macht und die Funktion LoadPicture()aufruft. Coding einfach in ein Modul kopieren und los gehts... (Die Funktion LoadPicture() gibt's natürlich nicht, dass musst Du Dir schon selber anpassen!!!)
Vielleicht hilft es Dir bei Deinem Problem weiter.
greets from MichL (Vienna)
Option Explicit
Private Const MYDOT = "\InsertGraficFiles.dot"
Private lang As Long
'
'
Public Sub AutoExec()
Dim oaItem As CommandBarControl
Dim NewItem As CommandBarControl
Dim ExitItem As CommandBarControl
Dim myItem As CommandBar
Dim newStr As String
Dim aTemp As String
Dim ItemIndex As Long
Dim eCount As Long
Dim ExitIndex As Long
'
'
On Error Resume Next
'
' So that we don't save our changes into normal.dot. This code also needs to
' be in AutoExit - wherever we make changes to Word.
aTemp = Application.StartupPath & MYDOT
CustomizationContext = Templates(aTemp)
'
'
Set myItem = CommandBars.Item("File")
If myItem.NameLocal = "File" Then
lang = 0
GoTo OnEnglish
ElseIf myItem.NameLocal = "Datei" Then
lang = 2
GoTo OnGerman
End If
'
'
'---------------
OnEnglish:
Set oaItem = CommandBars("File").Controls.Item("Acquire Pictures...")
newStr = oaItem.Caption
If newStr <> "Ac&quire Pictures..." Then
ItemIndex = CommandBars("File").Controls.Item("Exit").Index
Set NewItem = CommandBars("File").Controls.Add(Type:=msoControlButton, Temporary:=True)
With NewItem
.Move Before:=ItemIndex
.Caption = "Ac&quire Pictures..."
.TooltipText = "Acquire Pictures"
.Style = msoButtonCaption
.Visible = True
.BeginGroup = True
.FaceId = 0
.OnAction = "LoadPictures"
End With
End If
'
GoTo AllDone
'
'
'---------------
OnGerman:
Set oaItem = CommandBars("File").Controls.Item("Bilder erfassen...")
If oaItem.Caption <> "&Bilder erfassen..." Then
ItemIndex = CommandBars("File").Controls.Item("Beenden").Index
Set NewItem = CommandBars("File").Controls.Add(Type:=msoControlButton, Temporary:=True)
With NewItem
.Move Before:=ItemIndex
.Caption = "&Bilder erfassen..."
.TooltipText = "Bilder erfassen"
.Style = msoButtonCaption
.Visible = True
.BeginGroup = True
.FaceId = 0
.OnAction = "LoadPictures"
End With
End If
GoTo AllDone
'
'
'-----------------
AllDone:
eCount = CommandBars("File").Controls.Count
Set ExitItem = CommandBars("File").Controls.Item(eCount)
ExitIndex = ExitItem.Index
With ExitItem
.BeginGroup = True
End With
'
'so that we don't get the "Do you want to save..." message
Templates(aTemp).Saved = True
'
End Sub
'
'
Public Sub AutoExit()
' this will remove the ocraware global addin whenever Word is exited.
' When OmniPage is uninstalled, the Opware97.dot file is removed. However, when Word was
' run, the menu items continued to show, with no actions performed. Now, we will manually
' remove it from the AddIns list everytime we exit Word. And when Word is started the next
' time, if the Opware97.dot file is in the startup menu it will reload the AddIn.
Dim oaItem As CommandBarControl
Dim aTemp As String
Dim newStr As String
'
On Error Resume Next
' So that we don't save our changes into normal.dot. This code is also
' in AutoExex - wherever we make changes to Word.
aTemp = Application.StartupPath & MYDOT
CustomizationContext = Templates(aTemp)
'
If lang = 0 Then
Set oaItem = CommandBars("File").Controls.Item("Acquire Pictures...")
newStr = oaItem.TooltipText
If newStr = "Acquire Pictures" Then
oaItem.Delete
End If
ElseIf lang = 2 Then
Set oaItem = CommandBars("File").Controls.Item("Bilder erfassen...")
newStr = oaItem.TooltipText
If newStr = "Bilder erfassen" Then
oaItem.Delete
End If
End If
'
NormalTemplate.Saved = True
Templates(aTemp).Saved = True
'
End Sub
'
