Herbers Excel-Forum - das Archiv

Makro erst nach Datei öffnen ausführen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 23.04.2005 13:04:17
Servus,
ich muß mal glatt wieder eine Frage loswerden.
Ich öffne eine Datei über einen Commandbutton und möchte nachdem sie geöffnet ist automatisch eine Prozedur ablaufen lassen welche durch ein weiteres Makro ausgeführt wird. Also - wenn datei geöffnet dann führe weiteres Makro aus.
Ist sowas machbar?
schönen Tag noch
Frank
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Peter W
Geschrieben am: 23.04.2005 13:20:23
Servus,
führ doch einfach das zweite Makro, in der zweiten Arbeitsmappe,
unter diese Arbeitsmappe, mit dem Code Private Sub Workbook_Open() aus.
Nähere Details kann ich dir nicht geben, da ich die Codes nicht kenne ;)
MfG
Peter
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 23.04.2005 13:43:21
... ich habe mal den kompletten Code eingepflegt. Habe dies gestern mit Micha zusammengebastelt.
Erklärung: Ich habe eine Userform mir laufwerks, ordner und dateilistenfeld. Ist natürlich (VB6). Funktioniert ähnlich wie der Explorer. Wähle mir meine Datei im Dateilistenfeld aus und starte sie über den Commandbutton. Funktioniert super. Nun möchte ich aber im Anschluß untenstehendes makro "Text_In_Spalten" sofort hinterher ausführen lassen da dies meine datei modifiziert. Denkemal in der Richtung
If File1.Filename = open oder geöffnet Then gehe zu Text_in_Spalten - kriegs einfach nicht gebacken.
Frank
Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Command1_Click()
If File1.FileName = "" Then Exit Sub
Dim Pfad As String
Pfad = Space$(256)
Open "temp.xls" For Output As #1 'Dummy anlegen
Close #1
FindExecutable "temp.xls", vbNullString, Pfad 'Pfad zu Excel durch xls- Dummy ermitteln
Kill "temp.xls" 'Dummy löschen
If Pfad <> "" Then
Pfad = Left$(Pfad, InStr(Pfad, vbNullChar) - 1)
End If
If UCase$(Pfad) = UCase$(File1.Path & "\" & File1.FileName) Then Pfad = ""
Shell Pfad & " " & File1.Path & "\" & File1.FileName, vbMaximizedFocus
End Sub

Sub Text_in_Spalten()
Dim arrText, i As Integer, iCnt As Long
Application.ScreenUpdating = False
For iCnt = 1 To Range("A65536").End(xlUp).Row
arrText = Split(Cells(iCnt, 1), ";")
For i = 0 To UBound(arrText)
Cells(iCnt, i + 1) = arrText(i)
Next i
Next iCnt
Columns("D:G").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Application.CutCopyMode = False
End Sub
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Nepumuk

Geschrieben am: 23.04.2005 17:00:02
Hallo Frank,
folgendes kleine Beispiel zeigt eine Msgbox an, wenn die Mappe mit dem Namen "Mappe1.xls" offen ist.


Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, _
     ByVal lpWindowName As StringAs Long
Private Sub Form_Load()
    Timer1.Interval = 500
End Sub
Private Sub Timer1_Timer()
    If FindWindow("XLMAIN", "Microsoft Excel - Mappe1.xls") Then
        Timer1.Interval = 0
        MsgBox "Mappe offen"
    End If
End Sub


Gruß
Nepumuk
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 23.04.2005 18:06:32
Hallo Nepomuk,
da ich in VBA nicht so bewandert bin, kann ich Deinem Beispiel nicht so recht folgen zumal ich eine Fehlermeldung zu Timer1 bekomme - Variable nicht definiert. Definiere ich sie kommt der nächste Fehler etc.
Nochmal zu meinem Code. Er funktioniert 100%ig bis auf dem Umstand, dass ich den Code Text_in_Spalten irgendwie einbinden muß.
Deine Idee ist aber gar nicht so übel - wenn das mit der msgbox funktioniert könnte man als Text verfassen "Datei geöffnet, wollen sie die Datei modifizieren?" und dem ok Button mein "Text_in_spalten" makro zuweisen. Da brauche ich aber Hilfe da die Datei immer einen anderen Namen hat - es wird also noch komplizierter. Lieber wäre es mir es ginge von Anfang an nahtlos über.
Gruß Frank
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Nepumuk

Geschrieben am: 23.04.2005 18:21:39
Hallo Frank,
der Code hat mit VBA nichts zu tun. Das ist ein Beispielcode für VB. Füge in dein Form einen Timer ein (das Control das wie eine Uhr aussieht). Im aktiven Form ist es unsichtbar!
Userbild

Den Timer startest du, indem du ihm einen Intervall > 0 zuweist und stoppst ihn, indem du den Intervall wieder auf null setzt. Den Timer startest du nach dem öffnen der Mappe. Im Programm des Timers wird auf das öffnen der Mappe gewartet. Wenn die Mappe geöffnet ist, könntest du an Stelle der Msgbox dein "Text_in_Spalten" - Makro aufrufen. Oder den User, über eine Ja - Nein - Auswahl in der Msgbox, das Makro nach Bedarf ausführen lassen.
Gruß
Nepumuk
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank
Geschrieben am: 23.04.2005 18:31:20
hallo Nepumuk,
jetzt ist alles klar - das kommt davon, wenn man zwischen VB und VBA hin und her switscht. Werde es nach dann gleichmal ausprobieren!!
Gruß Frank
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 23.04.2005 19:18:20
Hallo Nepumuk,
es gibt eine gute und eine ... etwas weniger gute Nachricht. Die Gute Der Timer Funktioniert soweit, nur dass ich den genauen Namen der datei eingeben muß. Da die sich ändert wirds kompliziert. Zum anderen kommt die Message schon bevor ich die Datei im Filelidtfeld selektiert habe. Denke, das könnte man beheben. Jetzt kommt die Schlechte. Mein ganzer Code "Text_in_Spalten ist unter VBA geschrieben. VB kann den Code nicht lesen - in jeder zweiten Zeile Fehler, fehler....
Ich werde es so lassen wie bisher. Ich zeig Dir mal wie mein Code aussieht.
Schönen Abend noch Frank

Sub Text_in_Spalten()
Dim arrText, i As Integer, iCnt As Long
Application.ScreenUpdating = False
For iCnt = 1 To Range("A65536").End(xlUp).Row
arrText = Split(Cells(iCnt, 1), ";")
For i = 0 To UBound(arrText)
Cells(iCnt, i + 1) = arrText(i)
Next i
Next iCnt
Columns("D:G").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Application.CutCopyMode = False
kopieren
End Sub


Sub kopieren()
Sheets(1).Select
Sheets(1).Copy Before:=Workbooks("Kim_1.xls"). _
Sheets(1)
Application.Run "Kim_1.xls!transpons"
Sheets(1).Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets(3).Select
End Sub


Sub transpons()
Dim intRow As Integer
Dim x As String
Range("A1:HQ100").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("2:2").Select ' Zeile 2 gelöscht
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Application.DisplayAlerts = False
Create_Sheets
End Sub

Sub Create_Sheets()
Dim i As Integer
Dim lngRow As Long
Dim qWks As Worksheet, tWks As Worksheet
Dim ziel
Set qWks = Worksheets("Tabelle1")
With qWks
For i = 2 To .Range("IV2").End(xlToLeft).Column  ' auswahl betrifft Spalte B bis letzte IV
'If Len(.Cells(2, i)) > 0 And Len(.Cells(2, i)) < 9 Then  'sucht nach werten >8 zeichen
If .Cells(2, i) <> "" Then                   ' wenn in Zeile zwei in Spalte Wert gefunden dann
Set tWks = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'erstelle ein Arbeitsblatt nach ("Tabelle1")
tWks.Name = .Cells(2, i).Text           ' und übernehme den namen für das arbeitsblatt aus dem Zellenwert
.Range(.Cells(3, i), .Cells(.Cells(65536, i).End(xlUp).Row, i)).Copy tWks.Cells(2, 3) 'gehe in die Spalte und kopiere ab Zeile 3 bis zum letzten gefundenen Datensatz (Range 3 - 65536(max Zeile) in Zeile 2 Spalte 3
ziel = tWks.Name          'im neuangelegten Arbeitsblatt
Sheets("Radius").Columns("A:B").Copy  ' gehe ins Arbeitsblatt Radius - kopiere Spalte A und B
Sheets(ziel).Columns("A:B").Select     ' gehe in das neuangelegte Datenblatt markiere Spalten a und
ActiveSheet.Paste                       'und füge Spalten in A und B ein
.Cells(1, i).Copy tWks.Cells(1, 1) ' übernehme Wert aus B1,B2,B3,usw... und trage ein in generiertes Datenblatt A1
ziel = tWks.Name
Range("A1").Select
Selection.Font.ColorIndex = 3   ' ändere die schriftfarbe in Rot
Selection.Font.Bold = True      ' und Fettgedruckt
ziel = tWks.Name
Columns("C:F").Select
'Selection.Replace What:=".", Replacement:=""
Selection.Replace What:=",", Replacement:="."  ' Textzelle in Zahlzelle umgewandelt
'Cells(Rows.Count, Columns.Count).Copy
'Selection.PasteSpecial Paste:=-4104, Operation:=2
Cells.Select
Selection.Replace What:="N/A", Replacement:="0", ReplaceFormat:=False  ' suche zellen nach N/A und erstelle eine leerzelle
Selection.Replace What:="_", Replacement:="0", ReplaceFormat:=False      ' suche zellen nach __ und erstelle eine leerzelle
Columns("G:G").Select  ' wähle Spalte G
Selection.ColumnWidth = 3  ' spaltenbreite 3
Range("G1:G55").Select   ' markiere nur zellen 1-55
Selection.Interior.ColorIndex = 15  ' Zellfarbe grau
Sheets(ziel).Range("C1").Select
ActiveCell.FormulaR1C1 = "2705"
Selection.Font.Bold = True
Sheets(ziel).Range("D1").Select
ActiveCell.FormulaR1C1 = "2735"
Selection.Font.Bold = True
Sheets(ziel).Range("E1").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "2760"
Sheets(ziel).Range("F1").Select
ActiveCell.FormulaR1C1 = "2785"
Selection.Font.Bold = True
Sheets(ziel).Range("C56:C109").Select
Selection.Cut Destination:=Sheets(ziel).Range("D2:D55")
Sheets(ziel).Range("C110:C163").Select
Selection.Cut Destination:=Sheets(ziel).Range("E2:E55")
Sheets(ziel).Range("C164:C217").Select
Selection.Cut Destination:=Sheets(ziel).Range("F2:F55")
Sheets(ziel).Range("A1").Select
Sheets(ziel).Range("H1").Select
ActiveCell.FormulaR1C1 = "2705 zu 2735"
Selection.Font.Bold = True
Sheets(ziel).Range("I1").Select
ActiveCell.FormulaR1C1 = "2735 zu 2760"
Selection.Font.Bold = True
Sheets(ziel).Range("J1").Select
ActiveCell.FormulaR1C1 = "2760 zu 2785"
Selection.Font.Bold = True
'Dim lngRow As Long
For lngRow = 2 To 55                                                                    ' Zeilenauswahl = Zeile 2 bis 55
If IsNumeric(Cells(lngRow, 4).Text) And IsNumeric(Cells(lngRow, 3).Text) Then _
Cells(lngRow, 8).Value = Cells(lngRow, 4).Value - Cells(lngRow, 3).Value        ' suche in Spalte D=4 und 3=c nach einem Numerischen Wert
Next                                                                                     ' und schreibe ergebnis in Spalte H=9 von D4-D3  wenn eine Zelle kein
' kein numerischer Wert lasse zelle frei
For lngRow = 2 To 55
If IsNumeric(Cells(lngRow, 5).Text) And IsNumeric(Cells(lngRow, 4).Text) Then _
Cells(lngRow, 9).Value = Cells(lngRow, 5).Value - Cells(lngRow, 4).Value
Next
For lngRow = 2 To 55
If IsNumeric(Cells(lngRow, 6).Text) And IsNumeric(Cells(lngRow, 5).Text) Then _
Cells(lngRow, 10).Value = Cells(lngRow, 6).Value - Cells(lngRow, 5).Value
Next
Rows("28:41").Select            ' zeilen 28 - 41 auswählen
Selection.Font.ColorIndex = 5   ' mit Textfarbe 5(blau) ausführen
Rows("42:55").Select            ' zeilen 42 - 55 auswählen
Selection.Font.ColorIndex = 10  '  mit Textfarbe 10 (grün) ausführen
Columns("A:IV").EntireColumn.AutoFit ' Spalten A - IV ausrichten nach Datensatzlänge
Range("A1:F1").Select
Selection.HorizontalAlignment = xlLeft ' Zellen A1 bis F1 links ausgerichtet
Application.Run "Kim_1.xls!diagramm1"
Application.Run "Kim_1.xls!diagramm2"
End If
Next i
End With
End Sub

Sub diagramm()           ' Diagrammerstellung immer für das aktive Arbeitsblatt
Dim ber As Range            ' aktives Blatt als ber
Dim n1$, n2$, n3$, n4$    ' Definieren bestimmter Variablen zur späteren Zellzuweisung
Set ber = ActiveSheet.Range("A2:A55,C2:F55")    ' Werte für Diagramm aus aktiven Blatt
n1 = ActiveSheet.[c1]       ' Variablen dem aktiven Blatt + Zelle zuweisen
n2 = ActiveSheet.[d1]
n3 = ActiveSheet.[e1]
n4 = ActiveSheet.[f1]
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=ber _
, PlotBy:=xlColumns                         ' Sourceblatt als ber einsetzen
ActiveChart.SeriesCollection(1).Name = n1   '  Diagrammbeschriftung
ActiveChart.SeriesCollection(2).Name = n2
ActiveChart.SeriesCollection(3).Name = n3
ActiveChart.SeriesCollection(4).Name = n4
End Sub


Sub diagramm1()
Dim ber As Range, blN$
Dim n1$, n2$, n3$, n4$
blN = ActiveSheet.Name
With ActiveSheet
Set ber = .Range("A2:A55,H2:J55")
n1 = .[h1]
n2 = .[i1]
n3 = .[j1]
End With
Charts.Add
With ActiveChart
.ChartType = xlLineMarkers
.SetSourceData Source:=ber, PlotBy:=xlColumns
.SeriesCollection(1).Name = n1
.SeriesCollection(2).Name = n2
.SeriesCollection(3).Name = n3
.HasTitle = True
.ChartTitle.Characters.Text = blN
.Location Where:=xlLocationAsObject, Name:=blN
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Diagramm 1").IncrementLeft 183#
ActiveSheet.Shapes("Diagramm 1").IncrementTop 87#
End With
Application.SendKeys "{esc}"
Application.ScreenUpdating = True
Set ber = Nothing
End Sub

Sub diagramm2()
Dim ber As Range, blN$
Dim n1$, n2$, n3$, n4$
blN = ActiveSheet.Name
With ActiveSheet
Set ber = .Range("A2:A55,C2:F55")
n1 = .[c1]
n2 = .[d1]
n3 = .[e1]
n4 = .[f1]
End With
Charts.Add
With ActiveChart
.ChartType = xlLineMarkers
.SetSourceData Source:=ber, PlotBy:=xlColumns
.SeriesCollection(1).Name = n1
.SeriesCollection(2).Name = n2
.SeriesCollection(3).Name = n3
.SeriesCollection(4).Name = n4
.HasTitle = True
.ChartTitle.Characters.Text = blN
.Location Where:=xlLocationAsObject, Name:=blN
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Diagramm 2").IncrementLeft -183#
ActiveSheet.Shapes("Diagramm 2").IncrementTop -87#
End With
Application.SendKeys "{ESC}"
Application.ScreenUpdating = True
Set ber = Nothing
End Sub

Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Nepumuk

Geschrieben am: 23.04.2005 21:14:18
Hallo Frank,
sei mir nicht böse, aber ich habe keinen Bock deinen Code auf VB umzubauen. Ich habe dir mal ein kleines Beispiel gemacht, damit du siehst, wie das Prinzip funktioniert.
https://www.herber.de/bbs/user/21604.zip
Gruß
Nepumuk
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 23.04.2005 21:27:24
Hallo Nepumuk,
jetzt hast Du mich aber total falsch verstanden. Ich habe die Aktion vorhin eingestellt, weil der Code so umfangreich ist. Nur um Dir zu zeigen welches Aussmaß das annehmen würde, habe ich mal alles preisgegeben. Für diesen VBA Code habe ich sage und schreibe 4 tage gebraucht. Der Aufwand zum Nutzen wäre jetzt nicht mehr im Verhältnis. Ich öffne weiter meine dat datei und modifiziere sie über einen Butten in einer selbsterstellten Symbolleiste.
Schönes Wochenende noch
Frank
Bild

Betrifft: AW: Makro erst nach Datei öffnen ausführen
von: Frank

Geschrieben am: 03.05.2005 00:06:16
Hallo Nepumuk,
eine Frage habe ich jetzt doch noch zu dem Code, den Du nir geschickt hattest. Wie stelle ich es an, dass nicht nur Exceldateien angezeigt werden. Ich will eine .wrk Datei auswählen, welche mit excel geöffnet wird.
Gruß Frank
 Bild