Makro einbinden
14.02.2004 15:35:30
walter
habe über das Forum Hilfe erhalten und das Makro in Verbindung mit
Progressbar.exe läuft es einwandfrei, wenn ich ein Button erstelle.
Ich weiß nicht wie das in mein Makro einbinde über das Command-Button.
Hier mein Orginal Makro: dann folgen die Makros von Progressbar:
Private Sub CommandButton12_Click()
'--------------------------------- speichern C --------------------------------
Application.ScreenUpdating = False
Dim jdate
Dim Verzeichnis As String
Dim myFSO As Object, myDrv As Object, strFS As String
Set myFSO = CreateObject("Scripting.FileSystemObject")
Verzeichnis = "C:\Krefeld VL"
If myFSO.folderexists(Verzeichnis) Then
'If Dir(Verzeichnis, vbDirectory) <> "" Then
MsgBox "Verzeichnis " & Verzeichnis & " vorhanden", vbCritical
Else
MsgBox " Achtung Verzeichnis nicht vorhanden !!!" & Chr(13) & Chr(13) & _
" Es wurde nicht gespeichert ! " & Chr(13) & _
Chr(13) & " Es sollte jetzt ins Laufwerk ' C ' gesichert werden !" _
& Chr(13), vbCritical
Exit Sub
End If
Unload Me
jdate = Format(Now, "dd.mm.yyyy hh:mm")
Sheets("Laufende ").Select
ActiveSheet.Unprotect ("bk") 'schutz aufheben
Sheets("Laufende ").Range("c1").Value = Application.UserName
Sheets("Laufende ").Range("b2").Value = jdate
Hier habe ich vorerst reingesetzt: !!!
Application.Run "'KR-VF-04.xls'!PLK_speichern"
Application.DisplayAlerts = False
ChDrive "C:\Krefeld VL"
ActiveWorkbook.SaveAs Filename:= _
"C:\Krefeld VL\KR-VF-04.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = False ' Sicherheitsabfrage unterdrücken
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True, Password:="bk" 'schützen
'' ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Ab hier die Makro:
Private Sub Form_Load()
ProgressBar1.Max = GetSetting(Appname:="Progressbar", Section:="Laufzeit", Key:="Sekunden", Default:=5) * 72
Timer1.Interval = 1
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> 1 Then Cancel = 1
End Sub
Option Explicit
Private Sub Timer1_Timer()
ProgressBar1 = ProgressBar1 + 1
If ProgressBar1 = ProgressBar1.Max Then
Timer1.Interval = 0
End
End If
End Sub
Sub PLK_speichern()
'Public Sub speichern()
Dim dblZeit As Double
dblZeit = Timer
Shell "C:\Progressbar.exe", vbNormalFocus
' Shell "C:\KR-VF-04.xls", vbNormalFocus
ThisWorkbook.Save
SaveSetting Appname:="Progressbar", Section:="Laufzeit", Key:="Sekunden", Setting:=CInt(Timer - dblZeit)
End Sub
Hoffentlich klappt es das mir jemand einen Tip geben kann,
gruss Walter