"Bitte warten!" waehrend Makro

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich habe das ganz schick mit dem Office Assi gelöst:

Private asTitle As String
Private asTitle2 As String
Private asVisible As Boolean
Private oBlase As Balloon
Private rBlase As Balloon

Sub AssistentAuswahlAnzeigenUndWahlAusführen()
With Assistant
.Reduced = True
.Left = 900
.Top = 600
.MoveWhenInTheWay = True
.TipOfDay = True
.Visible = True
.Animation = msoAnimationGreeting
End With
asVisible = Assistant.Visible
asTitle = "Dateneingabe komplett!"
asTitle2 = "Bitte warten!"
Select Case BlaseAnzeigen
Case -1
If oBlase.CheckBoxes(1).Checked = True Then
DokumentSpeichern
Assistant.Animation = msoAnimationSaving
End If
ZweiteBlase
Case -2 'Der Benutzer hat den Dialog abgebrochen
If oBlase.CheckBoxes(1).Checked = True Then
DokumentSpeichern
End If
HappyEnd
End Select
HappyEnd
End Sub

Private Sub DokumentSpeichern()
ActiveWorkbook.Save
End Sub

Private Sub HappyEnd()
Assistant.Visible = asVisible
End
End Sub

Private Function BlaseAnzeigen()
Set oBlase = Assistant.NewBalloon
With oBlase
.Mode = msoModeModal
.BalloonType = msoBalloonTypeButtons
.Icon = msoIconTip
.Heading = asTitle
.Text = "Alle notwendigen Daten sind eingegeben. Wollen Sie die Berechnungen jetzt starten?" & _
" Dieser Vorgang kann einige Zeit in Anspruch nehmen."
.CheckBoxes(1).Text = "Eingegebene Werte speichern"
.Button = msoButtonSetOkCancel
BlaseAnzeigen = .Show
End With
End Function

Sub ZweiteBlase()
oBlase.Close
Blase2Anzeigen
NeueStunde = Hour(Now())
NeueMinute = Minute(Now())
NeueSekunde = Second(Now()) + 2
WarteZeit = TimeSerial(NeueStunde, NeueMinute, NeueSekunde)
Application.Wait WarteZeit
MakroStart
BlaseSchliessen
End Sub

Sub BlaseSchliessen()
rBlase.Close
Assistant.Animation = msoAnimationDisappear
Assistant.Visible = False
End Sub

Private Function Blase2Anzeigen()
Set rBlase = Assistant.NewBalloon
With rBlase
.Mode = msoModeModeless
.BalloonType = msoBalloonTypeButtons
.Icon = msoIconTip
.Heading = asTitle2
.Text = "Die Berechnungen laufen."
.Button = msoButtonSetNone
Blase2Anzeigen = .Show
End With
Assistant.Animation = msoAnimationWorkingAtSomething
End Function

Sub BlaseSchliessen()
rBlase.Close
Assistant.Animation = msoAnimationDisappear
Assistant.Visible = False
End Sub

Gruß,
Jessica

bin zwar fast schon weg, aber das hört sich an wie eine "Fortschrittsanzeige" !
So was ähnliches war vor einiger zeit mal mit walter heir.

Kleiner denkanstoss wäre:
Der Link dazu: http://j-walk.com/ss/excel/tips/tip34.htm
Displaying a Progress Indicator
A common question among Excel developers is, How can I use a custom dialog box to display the progress of a lengthy macro? This document describes how to create an attractive progress indicator with minimal effort.
Creating the UserForm
Follow the steps below to create the progress indicator UserForm.
Insert a new UserForm and change its Caption to Progress.
Add a Frame control and name it FrameProgress.
Add a Label control inside of the Frame and name it LabelProgress. Remove the Label's caption, and make its background color red.
Add another label (option) to describe what's going on.
Adjust the form and controls so they look like this:

Creating the Event-handler subroutines
The trick here involves running a subroutine automatically when the dialog box is displayed. Since the Initialize event occurs before the dialog box is actually show, you must use the Activate event. Insert the following subroutine in the Code window for the UserForm. This subroutine simply calls the Main subroutine (stored in a VBA module) when the UserForm is displayed.
Private Sub UserForm_activate()
Call Main
End Sub
The Main subroutine is listed below. This demo routine simply inserts random numbers into the active worksheet. As it does so, it changes the width of the Label control and displays the percent completed in the Frame's caption. You will, of course, substitute your own subroutine. And you'll need to figure out how to determine the progress complete.
Sub Main()
' Inserts random numbers on the active worksheet
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Cells.Clear
Application.ScreenUpdating = False
Counter = 1
RowMax = 100
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1
End Sub
Creating the start-up subroutine
All that's missing is a subroutine to display the dialog box. Enter the following subroutine in a VBA module.
Sub ShowDialog()
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub
How it works
When you execute the ShowDialog subroutine, the Label object's width is set to 0. Then the Show method of the UserForm1 object displays the dialog box. When the dialog box is displayed, its Activate event is triggered, which executes the Main subroutine. The Main subroutine periodically updates the width of the Label. Notice the DoEvents statement. Without this statement, changes to the Label are not visible. Before the subroutine ends, the last statement unloads the UserForm object.
Caveat
This is definitely a slick technique, but you should be aware that it may slow down your macro a bit due to the extra overhead of updating the progress indicator. In many cases, however, it is not even noticeable.

Ich persönlich habe das mal an nem kleinen bsp. versucht und fand das ganz gut !

Gruß
andreas e
http://www.skripteundaufgaben.de viele kostenlose Downloads und Lösungsansätze zu EXCEL und mehr

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

"Bitte warten!" waehrend Makro

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread