stdole.SavePicture Bild
22.02.2005 18:08:40
ransi
Guten Abend
habe ein problem mit folgendem code:
Option Explicit
Sub Bilder_als_gif()
Dim Bild
Dim Dummy_Bar As CommandBar
Dim Dummy_Button As CommandBarButton
Dim i As Integer
Dim pfad1 As String
Dim pfad2 As String
Dim pfad3 As String
Dim pfad4 As String
Dim pfad5 As String
Dim speicherpfad As String 'zum abspeichern der bilder
pfad1 = ThisWorkbook.Path & "\1-1000\" '5 Pfade weil ich glaube das
'5000 dateien in einem Ordner zuviel sind.
'Die ordner sind z.B. so benannt "1001-2000"
pfad2 = ThisWorkbook.Path & "\1001-2000\"
pfad3 = ThisWorkbook.Path & "\2001-3000\"
pfad4 = ThisWorkbook.Path & "\3001-4000\"
pfad5 = ThisWorkbook.Path & "\4001-5000\"
DoEvents 'gibt es noch was ähnliches ?
On Error Resume Next
CommandBars("egal").Delete 'falls schon vorhanden
Set Dummy_Bar = CommandBars.Add(Name:="egal")
For i = 1 To 5000 'wenn ich hier die 1000er schritte von hand ändere z.B.
'for i = 1001 to 2000
'und mit den geänderten werten den code neu starte kriege ich die gewählten dahin wo sie hin sollen.
Select Case i 'Auswahl für die 5 Verzeichnisse.Alle 1000 kommt der nächste Ordner.
Case 1 To 1000: speicherpfad = pfad1
Case 1001 To 2000: speicherpfad = pfad2
Case 2001 To 3000: speicherpfad = pfad3
Case 3001 To 4000: speicherpfad = pfad4
Case 4001 To 5000: speicherpfad = pfad5
End Select
Set Dummy_Button = Dummy_Bar.Controls.Add 'temporär wird später wieder gelöscht
With Dummy_Button
.FaceId = i
Set Bild = .Picture
stdole.SavePicture Bild, speicherpfad & i & ".gif"
Set Bild = Nothing
Dummy_Button.Delete
End With
Next i
CommandBars("egal").Delete ' weil temporär
End Sub
der code soll mir "alle" FaceIDs als .gif abspeichern.
da ich nicht weiss wieviele es gibt habe ich erstmal 5000 angenommen.
Vom prinzip her läuft der code.
das problem kommt in der schleife nicht immer beim selben "i".
es kommt folgende Fehlemeldung:
"Microsoft Excel hat ein Problem festgestellt und muss beendet werden !"
Mit der üblichen Bitte nach Hause telefonieren zu dürfen.
senden \ nicht senden
dann wird excel beendet und neu gestartet.
Meine Frage ist ist nun ob das ein Excelproblem ist oder evtl. meine Rechenleistung nicht ausreicht ?
Wie kann ich den code zum laufen bringen ohne das excell abstürzt?
danke schonmal
ransi