AW: Drucken mit Macro
10.01.2005 09:39:47
Jörg
Hallo Andre,
aber erst mal ein frohes neues in die Runde.
Ganau das konnte ich nachvollziehen. Kann es evt. sein das dies am Menü
liegen könnte?
Denn wenn ich eine andere MAppe selektiere, dann flackert das Bild kurz.
Hier der Code fürs Menü:
Sub CreateControl()
Dim objCntr As CommandBarControl
Dim objBtn As CommandBarButton
Dim objPopUp As CommandBarPopup
'Begin insert Datei
On Error Resume Next
Application.CommandBars("FB0111").Controls("File").Delete
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=1, Temporary:=True)
If Err <> 0 Then
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=0, Temporary:=True)
End If
On Error GoTo 0
objPopUp.Caption = "File"
'End insert Datei
'Begin insert Bearbeiten
On Error Resume Next
Application.CommandBars("FB0111").Controls("Edit").Delete
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=2, Temporary:=True)
If Err <> 0 Then
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=1, Temporary:=True)
End If
On Error GoTo 0
objPopUp.Caption = "Edit"
'End insert Bearbeiten
'Begin insert Wartung
On Error Resume Next
Application.CommandBars("FB0111").Controls("Maintenance").Delete
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=3, Temporary:=True)
If Err <> 0 Then
Err.Clear
Set objPopUp = Application.CommandBars("FB0111").Controls.Add(Type:=msoControlPopup, Before:=2, Temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "Simpati Import Spatial"
.OnAction = "simpati_import_9mess"
.BeginGroup = False
.Style = msoButtonCaption
End With
'End insert Simpati Import Raum
'Begin insert Handeingabe_Raum
On Error Resume Next
Application.CommandBars("FB0111").Controls("Calibration").Controls("Manual input").Delete
Err.Clear
Set objBtn = Application.CommandBars("FB0111").Controls("Calibration").Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
If Err <> 0 Then
Err.Clear
Set objBtn = Application.CommandBars("FB0111").Controls("Calibration").Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
End If
On Error GoTo 0
With objBtn
.Caption = "Manual input form Spatial"
.OnAction = "Hand_Protokolle_raum"
.BeginGroup = False
.Style = msoButtonCaption
End With
'End insert Handeingabe Raum
End Sub
Sub CreateCmdBar()
Dim objBar As CommandBar
'Begin insert FB0111
On Error Resume Next
Application.CommandBars("FB0111").Delete
On Error GoTo 0
Set objBar = Application.CommandBars.Add("FB0111", msoBarTop, False, False)
objBar.Visible = True
'End insert FB0111
End Sub
Gruß Jörg