Ein Excel Makro zum vorbereiten einer Excel Datei für Filemaker

[Gast 123]

noch einfacher gesagt:

Nach dem einfügen der Const Zeile - diese beiden Zeilen im Makor einfach löschen!  Das ist schon alles!

  strDateiname = Empty '("Testmappe.xls")     '## Empty löschen und direkt eine Namen angeben, oder
  strDateiname = Range("xxx").Value           '## Const ganz oben vpr Sub Import einfügen!!

[philippu2006]

Hallo nochmal, Dankeschön für die vielen Hilfestellungen. Ich komme aber mit den Tips einfach nicht zurecht.
Ich habe noch nie mit Makros gearbeitet und diese ganzen Befehle sind für mich komplett unverständlich, daher mache ich es sicher irgendwie falsch.

Das ist aktuell mein Makro:

Code:

Sub Import_vorbereiten()
' Import_vorbereiten Macro

  'Datei über Dialog Öffnen
   Datei = Application.GetOpenFilename
   If Datei = Empty Then Exit Sub

   'wofür ist der 1.Befehl ???  wird er gebraucht??
   ExecuteExcel4Macro "WINDOW.MOVE(16,-35,"""")"
   Workbooks.Open Filename:=Datei
   
   Cells.UnMerge  'verbundene Zellen auflösen
   
   'Zeilen + Spalten löschen
   Rows("1:13").Delete Shift:=xlUp
   Columns("A:A").Delete Shift:=xlToLeft
   
   'Spalten Breite einstellen
   Columns("A:AW").ColumnWidth = 2.83
   Columns("A:AW").ColumnWidth = 9.67
   
   
   '** welche Sinn macht das Selektieren ???
   '   ausser zum Ansehen gibt es hier keine Funktion !!
   Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S").Select
   Range("S1").Activate
   ActiveWindow.SmallScroll ToRight:=5
   Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X").Select
   Range("X1").Activate
   ActiveWindow.SmallScroll ToRight:=13
   Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA," & _
     "AB:AB,AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO").Select
   Range("AO1").Activate
   ActiveWindow.SmallScroll ToRight:=10
   Union(Range("AV:AV,AW:AW,B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA,AB:AB," & _
      "AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO,AQ:AQ,AR:AR,AS:AS"), _
      Range("AT:AT,AU:AU")).Select
   Range("AW1").Activate
   ActiveWindow.SmallScroll ToRight:=12
   Range("AW6").Select
   ActiveWindow.SmallScroll ToRight:=-222
   '** ganzer Block unnütze Funktionen, am besten löschen !!
       
   'Spalten Bereich gezielt löschen
   Range("B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I").Delete Shift:=xlToLeft
   Range("C:C,D:D,E:E,F:F,H:H,I:I,J:J,K:K").Delete Shift:=xlToLeft
   Range("E:E,F:F,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R").Delete Shift:=xlToLeft
   Range("H:H,I:I,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R,S:S,T:T").Delete Shift:=xlToLeft
   
   'Spalten + Zeilen löschen
   Columns("I:X").Delete Shift:=xlToLeft
   Rows("4:4").Delete Shift:=xlUp
   Rows("1:2").Delete Shift:=xlUp
   
   'Zeilenhöhe einstellen
   Rows("1:7").RowHeight = 16
   
  'Datei Vorgabe zum Speichern  (oder Empty)
  strDateiname = Import
  
  'Datei über Dialog speichern
  Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
  ActiveWindow.Close
  
  Workbooks("Import vorbereiten.xlsm").Close False
Application.Quit
End Sub

Ein paar Dinge funktionieren noch nicht so richtig.
Zum einen würde ich den Dateinamen und die Endung definieren.
Außerdem sollte es automatisch abgespeichert werden ohne Frage an den Benutzer -> gewünscht währe da dass es genau an dem selben Ort gespeichert wird wo auch die OpenReport Datei liegt. Sprich egal auf welchem Computer ich arbeite dass der Pfad immer der der Open Report Datei ist.
Und am Ende nach dem Speichern (was manuell schon funktioniert) stürzt Excel allerdings komplett ab. Die Datei ist gespeichert aber trotzdem irritierend für den späteren Nutzer.
Ich weiß es ist viel verlangt aber wenn jemand Lust hat währe es cool wenn mir jemand den vollständigen Code schickt den Ich einfügen kann das währe wirklich super.

[schauan]

Hallöchen,

dann fangen wir mal mit dem Öffnen der Datei an.

Zum einen würde ich den Dateinamen und die Endung definieren.

Im Code steht

Code:

  'Datei über Dialog Öffnen
   Datei = Application.GetOpenFilename

Du nimmst dann nicht den Dialog sonder Deine Vorgabe, ggf. inklusive Pfad. Wenn die Exceldatei im gleichen Pfad liegt, reicht als Angabe ThisWorkbook.Path. Schaue Dir das aber in der Überprüfung an, eventuell fehlt ein Backslash.

Die nächste Zeile im Code ist

Code:

   If Datei = Empty Then Exit Sub

Das geht dann nicht auf. Hier prüfst Du dann mit Dir:

Code:

If Dir(Datei)=""  Then Exit Sub

Falls Du das Verzeichnis wählen musst, dann melde Dich noch mal. Dann nehmen wir das auch noch in Angriff.

[philippu2006]

Hallo Ihr Excel Profis :)
Nach langem Urlaub und ich gebs zu ich hab zwischendurch auch aufgegeben ::)ersuch ich das ganze jetzt nochmal. Irgendwie muss es ja funktionieren.

Unten eingebettet mal der Code. Da sind auch noch die Notizen eines Helfers aus diesem Thread drin.
Da ich wie gesagt totaler Noob bin währ es cool wenn mor jemand den Code anpassen kann ?
Zu meinem Vorredner, ich habe deine Ämderunge hoffentlich richtig eingefügt. Gut währe es (ich weiss nicht ob man das pauschal definieren kann) wenn die aufzurufende Datei eine Ordnerebene höher liegen kann. 
Der Ordner indem die Datei Import.xls liegt heisst Kronos Viewer in diesem ist ein Ordner Systemdateien in welchem dann die XLSM liegt in der untenstehendes Script liegt. Vlt kann mir einer von euch helfen :)

Lg Philipp

Code:

Sub Import_vorbereiten()
' Import_vorbereiten Macro

 'Datei über Dialog Öffnen
  Datei = ThisWorkbook.Path
  If Dir(Datei) = "" Then Exit Sub

  'wofür ist der 1.Befehl ???  wird er gebraucht??
  ExecuteExcel4Macro "WINDOW.MOVE(16,-35,"""")"
  Workbooks.Open Filename:=Datei
 
  Cells.UnMerge  'verbundene Zellen auflösen
 
  'Zeilen + Spalten löschen
  Rows("1:13").Delete Shift:=xlUp
  Columns("A:A").Delete Shift:=xlToLeft
 
  'Spalten Breite einstellen
  Columns("A:AW").ColumnWidth = 2.83
  Columns("A:AW").ColumnWidth = 9.67
 
 
  '** welche Sinn macht das Selektieren ???
  '   ausser zum Ansehen gibt es hier keine Funktion !!
  Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S").Select
  Range("S1").Activate
  ActiveWindow.SmallScroll ToRight:=5
  Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X").Select
  Range("X1").Activate
  ActiveWindow.SmallScroll ToRight:=13
  Range("B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA," & _
    "AB:AB,AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO").Select
  Range("AO1").Activate
  ActiveWindow.SmallScroll ToRight:=10
  Union(Range("AV:AV,AW:AW,B:I,K:K,L:L,M:M,N:N,P:P,Q:Q,R:R,S:S,U:U,V:V,W:W,X:X,Z:Z,AA:AA,AB:AB," & _
     "AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AJ:AJ,AK:AK,AL:AL,AM:AM,AN:AN,AO:AO,AQ:AQ,AR:AR,AS:AS"), _
     Range("AT:AT,AU:AU")).Select
  Range("AW1").Activate
  ActiveWindow.SmallScroll ToRight:=12
  Range("AW6").Select
  ActiveWindow.SmallScroll ToRight:=-222
  '** ganzer Block unnütze Funktionen, am besten löschen !!
     
  'Spalten Bereich gezielt löschen
  Range("B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I").Delete Shift:=xlToLeft
  Range("C:C,D:D,E:E,F:F,H:H,I:I,J:J,K:K").Delete Shift:=xlToLeft
  Range("E:E,F:F,G:G,H:H,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R").Delete Shift:=xlToLeft
  Range("H:H,I:I,J:J,K:K,L:L,M:M,O:O,P:P,Q:Q,R:R,S:S,T:T").Delete Shift:=xlToLeft
 
  'Spalten + Zeilen löschen
  Columns("I:X").Delete Shift:=xlToLeft
  Rows("4:4").Delete Shift:=xlUp
  Rows("1:2").Delete Shift:=xlUp
 
  'Zeilenhöhe einstellen
  Rows("1:7").RowHeight = 16
 
 'Datei Vorgabe zum Speichern  (oder Empty)
 strDateiname = Import
 
 'Datei über Dialog speichern
 Application.Dialogs(xlDialogSaveAs).Show (strDateiname)
 ActiveWindow.Close
 
 Workbooks("Import vorbereiten.xlsm").Close False
Application.Quit
End Sub

[schauan]

Hallöchen,

hier mal ein Ansatz zu Ordnerebenen:

MsgBox Left("C:\AB\CD\EFG", InStrRev("C:\AB\CD\EFG", "\"))
MsgBox Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))

Das
"WINDOW.MOVE(16,-35,"""")"
stammt noch aus alten Excel-4-Zeiten und deswegen muss das
ExecuteExcel4Macro
davor ...

[philippu2006]

Danke für die schnelle Antwort. Aber ich muss da leider passen. Das was du da schreubst ist sicher korrekt aber ich kann damit null anfangen da ich nicht weiss was diese Zeichenketten bedeuten und ich dies wie gesagt nur dieses eine mal brauchen werde da ich sonst nie mit excel arbeite. Cool währe wenn du den tipp einfach in meinen code anhang einfügen könntest und wenn ich dann noch etwas anpassen muss einfach dazuschrieben.

Weil ich leider nichts mit instrgrev oder msgbox anfangen kann.
Sorry wenn ich da nich so viel erfahrung mit habe :)


Also folgendes sollte passieren mit dem Code den ich eingebettet habe.

Bei Klick auf den Button in der Excel Datei öffnet sich automatisch die Datei Import.xls eine Ordnerebene höher. 
Diese wird dannn bearbeitet (funktioniert super)
Dann wird sie wieder abgespeichert automatisch mit dem Dateinamen Filemaker_Import.xls in dem Ordner wo auch Import.xls liegt
Sollte die Datei schon vorhanden sein dann wird Sie automatisch überschrieben ohne Nachfrage bestenfalls.

Meinst du das wir das hinkriegen?

[schauan]

Hallöchen,

in Deinem Code hast Du die Zeile

Datei = ThisWorkbook.Path

Die ersetzt Du mit

Datei = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))


Mache aber vor dem Test eine Sicherheitskopie der Daten.

[philippu2006]

Okey ich glaube so könnte es funktionieren ::) vielen Dank schonmal 

Nach der Eingabe von deiner Zeile kommt jetzt das hier

[schauan]

Hallöchen,

In der "gelben" Zeile stand aber vorher was anderes...

[philippu2006]

Das funktionierte leider auch nicht.
Ach ist es beim Mac evtl. anders mit den Pfaden?