Supportnet / Forum / Tabellenkalkulation

Servus, Ich habe ein Macro, dass in einen Ordner geht und Dateien öffnet. Den Pfad habe ich im Macro bestimmt und könnte den auch ersetzen. Wollte mal fragen, ob es auch möglich wäre den Pfad in eine Zelle zu schreiben. Was müsste ich im Macro umschreiben? .LookIn = "C:\Geschäft" So funktioniert es. Wenn mein Pfad in Zelle C4 steht, kann ich dann einfach den Pfad durch C4 tauschen? Vielen Dank

Hallo Fragenkatalog,

ansich sollte das problemlos funktionieren.

Sub Makro1()
Workbooks.Open Filename:=Range("A1")
End Sub

Hiermit wird das Workbook dessen Pfad in A1 steht geöffnet.

MfG

JöKe

Hallo Fragenkatalog,

ich finde Deine Quelltextangabe nicht gerade riesig und kann mir kaum eine Vorstellung machen, was Du wirklich brauchst, aber vielleicht hilft Dir dies:

Dim pfad As String

´ falls Mappe in Excel geöffnet, aber nicht im Vordergrund ist
´ Windows("Dateiname.xls").Activate

pfad = Sheets("Tabelle1").Range("C4").Value
´ Variable pfad enthält nun den Wert von C4

´ Anzeige zur Kontrolle
´ mb = MsgBox(pfad, vbOKOnly, "Der Pfad ist:")

Gruß,
CaroS

Hallo,
Ich habe jetzt mal das Modul kopiert.
Hoffe ihr könnt mir da helfen.
Wie gesagt das Makro öffnet alle Dateien, die in einem Ordner stehen.
Da ich nicht immer ins Modul will um das zu ändern, möchte ich den Pfad in einer Zelle stehen haben.

Danke



Sub Druck()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Geschäft"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)

ActiveWindow.ScrollRow = 1
Sheets("I. Database extract").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Workbooks(2).Close
Next Mappen
End If
End With
End Sub

Hallo Fragenkatalog,

du brauchst nur @ CaroS Vorschlag einbauen.

Sub Druck()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
Dim Pfad As String
Application.DisplayAlerts = False
Pfad = Sheets("Tabelle1").Range("C4")
With Application.FileSearch
.NewSearch
.LookIn = Pfad
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)

ActiveWindow.ScrollRow = 1
Sheets("I. Database extract").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Workbooks(2).Close
Next Mappen
End If
End With
End Sub


Pfad = Sheets("Tabelle1").Range("C4") muss du natürlich deinen Wünschen anpassen.


MfG

JöKe

Vielen Dank..

Jungs Ihr seid klasse.

• wieder Makro Code
• Öffnen der Tabelle an vorgegebener Zelle
• Zellbezug Buchstaben
• Ergebniss gesucht