AW: Ausführen eines Codes auf anderer Arbeitsmappe
12.04.2006 16:34:29
Bernd
Hallo Remo und alle anderen,
so einfach ists glaub ich nicht,funktioniert so nicht (oder ich mach was falsch!)
Falls das nicht deutlich wurde, wills noch etwas genauer erklären:
Die Datei "003.xls" ist ein Abruf aus SAP, der einfach nur abgerufen und eben so gespeichert wird.
Die Datei "Produktionsauslastung.xls" ist eine Datei für die wöchentliche Auslastung. In dieser hab ich 52 Tabellenblätter (für jeden Monat eins). Diese werden beim Öffnen entsprechend ein- und ausgeblendet. Aber das tut hier nichts zur Sache.
Auf jeden Fall hab ich bis jetzt geplant, auf jedem Arbeitsblatt (also bspw. 13.) ein Button zu platzieren. Hinter diesem ist dann eben der Code gespeichert. (also hier z. B. in Worksheet 13). Beim Klicken soll dann die andere Datei geöffnet, in diesem dann ein paar Formatänderungen und ähnliches durchgeführt und danach diesen Inhalt auf das Arbeitsblatt 13 kopiert werden. Nur ist ja der Code auf Worksheet (hier 13) und nicht bzw. kein eigenständiges Makro.
Diesen Code hab ich bis jetzt und der funktioniert auch als Makro einwandfrei!
(Dank auch an alle, die mir geholfen haben!):
Private Sub CommandButton3_Click()
ChDir "C:\Dokumente und Einstellungen\bab10\SapWorkDir"
Workbooks.OpenText Filename:= _
"C:\Dokumente und Einstellungen\bab10\SapWorkDir\003.xls", Origin:=xlWindows _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), TrailingMinusNumbers:=True
'Ausführung des eigentlichen Makros
Dim y As Long 'Variable erstellen
'Inhalte von Spalte D in C
For y = Cells(65356, 4).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 4).Value <> "" Then Cells(y, 3).Value = Cells(y, 4).Value
Next
'Inhalte von Spalte F in G
For y = Cells(65356, 6).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 6).Value <> "" Then Cells(y, 7).Value = Cells(y, 6).Value
Next
'Inhalte von Spalte A in B
For y = Cells(65356, 1).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 1).Value <> "" Then Cells(y, 2).Value = Cells(y, 1).Value
Next
'Inhalt Bezeichnung
For y = Cells(65356, 8).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 8).Formula <> "" Then
Formel = Cells(y, 8).Formula
Cells(y, 5).Value = Right(Formel, Len(Cells(y, 8).Formula) - 1)
End If
Next
'Leerzeilen löschen, die den Bedingungen entsprechen
'Löschen der restlichen Leerzeilen, die den Bedingungen entsprechen
For y = Cells(65356, 2).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 2).Value = "" And Cells(y - 1, 2).Value = "Kapazitätsart" Then Rows(y).Delete 'Prüfung und löschen
Next
'Leerspalte einfügen
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
'Formeln erstellen und nach unten kopieren
Range("B2").Select
Dim iRows As Long
iRows = Range("D65536").End(xlUp).Row
Range(Cells(1, 3), Cells(iRows, 3)).FormulaR1C1 = _
"=IF(MID(RC[-1],4,2)=""00"",LEFT(RC[-1],2),IF(RC[-1]>0,RC[-1],"" ""))"
'Wert "1" in Kapazitätsgruppe wird gesucht und gelöscht
For y = Cells(65356, 2).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1 (wenn umgekehrt dann wird dein Makro endlos laufen)
If Cells(y, 5).Value = "1" Then Cells(y, 5).Clear
Next
'Kapazitätsgruppe wird wegen Verweis nach unten kopiert
wert = ""
For X = 1 To Cells(65356, 2).End(xlUp).Row
If Not Cells(X, 5) = "" Then wert = Cells(X, 5) Else Cells(X, 5) = wert
Next
'Alles markieren - kopieren - Inhalte einfügen
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Löschen überflüssige Spalten
Range("A:A,B:B,g:g,i:i,m:m,n:n").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'Optimale Spaltenbreite
Cells.EntireColumn.AutoFit
Range("A2").Select
'Hilfspalte für Verweis anlegen und ausblenden
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D7").Select
iRows = Range("A65536").End(xlUp).Row
Range(Cells(1, 4), Cells(iRows, 4)).FormulaR1C1 = _
"=RC[-1]&"" ""&RC[-3]"
Range("D7:D29").Select
Columns("D:D").EntireColumn.AutoFit
Columns("C:D").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
'erste Spalte in Format Zahl umwandeln (SVerweis würde sonst nicht funktionieren!)
Range("J1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.Copy
'Markieren Spalte A bis zum letzten Zeileneintrag
Range(Cells(1, 1), Cells(Cells(65356, 1).End(xlUp).Row, 1)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("J1").Select
Selection.ClearContents
Range("A1").Select
'ab hier Formatierungen
'Bezeichnung fett
For y = Cells(65356, 2).End(xlUp).Row To 2 Step -1 'Ermittlung der letzten Zeile und Schleife bis 1
If Len(Cells(y, 5)) > 8 And Cells(y, 5) <> "Angebot" Then Cells(y, 5).Select
'.FontStyle = "Fett"
' Range("D2").Select
With Selection.Font
.FontStyle = "Fett"
End With
Next
End Sub
Und jetzt möcht ich eigentlich nur, daß die Änderungen in der Datei "003.xls" durchgeführt werden und nicht in der Datei "Produktionsauslastung.xls".
Hoffe habs jetzt besser erklärt!
Schon jetzt vielen Dank!
Gruß
Bernd