Makroausführung
20.05.2005 09:01:31
Thomas
Ich habe 21 Dateien, aus denen ich Daten (gleichartige Größe und Struktur, aber je an anderer Stelle in der jeweiligen Tabelle)entnehmen und anders zusammenstellen muß. Das ganze periodisch mindestens halbjährlich, deshalb lieber automatisiert.
Das Makro habe ich fertig und es funktioniert, wenn ich es über Extras/Makro/ausführen aufrufe.
Den nächsten Schritt, mit dem die Kollegen dieses Makro per Knopfdruck (auf ein graphisches Steuerelement) auch anwenden können sollen, läßt VBA nicht zu. Jedesmal Fehlermeldungen.
Ich habe noch nicht herausbekommen, wo der Unterschied in der Ausführung liegt.
Hier mal ein Teil des funktionierenden Makros (ähnliche Wiederholung für jede der 21 zu öffnenden Dateien):
'1 Daten auswählen Datei1
' Datei aus dem Verzeichnis "r:\_statist\Test\" öffnen
ChDir "r:\_statist\Test\"
Application.CutCopyMode = False
Workbooks.Open Filename:="r:\_statist\Test\Datei1.htm"
Calculate
' Automatisches Heraussuchen der Datentabelle, Markierung und Kopie
' Gleiches Merkmal des gesuchten Bereiches ist in der Zelle darüber "(SUM)"
Cells.Find(What:="(SUM)", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Selection.Offset(1, 0).Range("A1:d46").Select
Selection.Copy
'Daten in neue Tabelle eintragen
Windows("Basisdatei.xls").Activate
Sheets("Datei1").Select
Range("a1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Formatierung mit Tausenderpunkt
Selection.NumberFormat = "#,##0"
'Datenbereich sortieren
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Höhe und Breite anpassen
Columns("A:A").Select
Selection.ColumnWidth = 51
Selection.Rows.AutoFit
' Name vergeben
ActiveWorkbook.Names.Add Name:="Datei1", RefersToR1C1:="=Datei1!R1C1:R45C4"
' Tausenderwerte korrigieren
' Hier muß dann noch die Korrektur der Übertragungsfehler erfolgen.
' Hintergrund: Bei der Extraktion aus der .htm-Datei wurde der Tausenderpunkt
' mitgenommen und als Komma interpretiert. So wird er dann auch eingefügt, so
' daß statt der Tausenderzahl eine mit drei Stellen hinter dem Komma dasteht.
' Die Korrektur ist einfach: In den Übertragungstabellen werden die Nicht-Ganzen
' Zahlen gesucht und mit 1000 multipliziert. Damit ist auch die unterdrückte
' Null ganz rechts wieder da.
Dim rgn1, zelle1 As Range 'rgn(n) und zelle(n), da wiederholte Anwendung
Set rgn1 = Range("b2:d46")
For Each zelle1 In rgn1
If zelle1 Int(zelle1) Then
zelle1 = (zelle1 * 1000)
End If
Next
'Datei schließen
Windows("Datei1.htm").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.Close
Hat jemand eine Idee, was VBA beim graphischen Steuerelement daran auszusetzen hat und wie ich das für die Anwendung des Buttons besser schreiben könnte (oder wo ich das herausbekommen könnte)?
Vielen Dank schon einmal für die Mühe
Thomas