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

Beiträge aus den Excel-Beispielen zum Thema "Kombinationsfeld"