Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
628to632
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

@IngGI - Vielen Dank...!!!!!!!!

@IngGI - Vielen Dank...!!!!!!!!
28.06.2005 14:24:44
Ingo
Thema: Daten auslesen aus geschlossenen Dateien - Angebotsauswertung
Hallo Ingolf,
vielen Dank für Deine Unterstützung!!! Es funktioniert...! Habe die Dateien gelöscht, die das Makro zum Absturz brachten und sie mit "durchlaufenden" Dateien neu abgespeichert. Vielen Dank nochmal. Ohne Deine Unterstützung hätte ich das nie hinbekommen...
Eine kleine Frage hätte ich trotzdem noch:
Könnte man in die Angebotsauswertung auch "automatisch" einen Hyperlink einfügen, die dann (im Bedarfsfall) aus der Auswertung heraus wieder direkt in das Angebot verknüpfen...?
Gruß aus HH, Ingo

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @IngGI - Vielen Dank...!!!!!!!!
28.06.2005 15:41:35
IngGi
Hallo Ingo,
füge hinter den ganzen ThisWorkbook... - Befehlen noch folgende Zeile ein:

ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:=Range("A65536").End(xlUp).Offset(0, 3), _
Address:=f.Path, TextToDisplay:=f.Path

Jetzt bekommst du in Spalte D für jede Datei einen Hyperlink.
Gruß Ingolf
AW: @IngGI - Vielen Dank...!!!!!!!!
28.06.2005 16:23:21
Ingo
hallo ingolf,
vielen dank für den tip. problem ist jedoch beim Einfügen dieser beiden Zeilen, daß das Marko nach dem Öffnen der ersten Datei stehen bleibt und nichts mehr macht. Wenn ich dann in die Auswertung gehe, sind zwar alle anderen Einträge aus der ersten Datei zu sehen, aber kein Hyperlink....,
Do you know what´s happend...?
Gruß, Ingo
Anzeige
AW: @IngGI - Vielen Dank...!!!!!!!!
28.06.2005 17:37:24
IngGi
Hallo Ingo,
ich hab gerade meinen ganzen Wochenvorrat an Flüchen verbraucht, bis ich auf den Fehler gekommen bin. Geschieht mir aber ganz recht. Die Zeile war einfach schlampig von mir geschrieben. So sollte es gehen:

ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:= _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 3), _
Address:=f.Path, TextToDisplay:=f.Path

Gruß Ingolf
AW: @IngGI - Vielen Dank...!!!!!!!!
29.06.2005 08:15:57
Ingo
Guten morgen Ingolf,
...immer ruhig bleiben...! In der Ruhe liegt die Kraft...!
Habe Dir jetzt nochmal den gesamten Code eingestellt, den ich hier verwende. Leider ist das Probleme mit Deiner neuen Version noch nicht behoben. Kann es daran liegen, daß er die Daten aus den Angeboten aus den Sheet(2) holt? Doch eigentlich nicht?! Es geht ja lediglich um den File-Name, den Excel darstellen soll....
Das Makro läuft bis zum ersten Angebot und bleibt stehen. Wenn ich das Makro "Schrittweise" laufen lasse F8 fängt er wieder bei der ersten Datei von vorne an...
Wäre wirklich toll, wenn Du da nochmal drüber schauen könntest...
Gruß, Ingo
--------------------------------

Sub Uebersicht()
Dim fso As Object, fo As Object, f As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFolder("\\eyfps\home\Projektplanung\Projekte\Angebote 25_000€\06-2005\")
On Error GoTo Fehler
'Application.ScreenUpdating = False
For Each f In fo.Files
Workbooks.Open (f.Path)
'Übersicht nächste freie Zeile, Spalte Kd-Nr.
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = _
Workbooks(f.Name).Sheets(2).Range("B2")
'Übersicht nächste freie Zeile, Spalte Kd-Name
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1) = _
Workbooks(f.Name).Sheets(2).Range("B3")
'Übersicht nächste freie Zeile, Spalte Kd-Ort
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 2) = _
Workbooks(f.Name).Sheets(2).Range("B4")
'Übersicht nächste freie Zeile, Spalte AN-Nr.
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 3) = _
Workbooks(f.Name).Sheets(2).Range("B5")
'Übersicht nächste freie Zeile, Spalte AN-Volumen
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 4) = _
Workbooks(f.Name).Sheets(2).Range("B7")
'Übersicht nächste freie Zeile, Spalte AN-Positionen
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 5) = _
Workbooks(f.Name).Sheets(2).Range("B8")
'Übersicht nächste freie Zeile, Spalte AN-Innendienst
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 6) = _
Workbooks(f.Name).Sheets(2).Range("d2")
'Übersicht nächste freie Zeile, Spalte AN-Außendienst
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 7) = _
Workbooks(f.Name).Sheets(2).Range("d3")
'Übersicht nächste freie Zeile, Spalte AN-Abteilungsleiter
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 8) = _
Workbooks(f.Name).Sheets(2).Range("d4")
'Übersicht nächste freie Zeile, Spalte AN-Besuchsfregquenz
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 9) = _
Workbooks(f.Name).Sheets(2).Range("d5")
'Übersicht nächste freie Zeile, Spalte AN-Abgabetermin
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 10) = _
Workbooks(f.Name).Sheets(2).Range("k3")
'Übersicht nächste freie Zeile, Spalte AN-Status
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 11) = _
Workbooks(f.Name).Sheets(2).Range("h9")
'Übersicht nächste freie Zeile, Spalte AN-Hyperlink
ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:= _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 12), _
Address:=f.Path, TextToDisplay:=f.Path
Workbooks(f.Name).Close False
Next f
Fehler:
Application.ScreenUpdating = True
End Sub

Anzeige
AW: @IngGI - Vielen Dank...!!!!!!!!
29.06.2005 11:41:37
IngGi
Hallo Ingo,
bei mir läuft das Makro. Allerdings ist mir jetzt eingefallen, dass in dem Ordner mit den Quelldateien keine anderen Dateien drin sein dürfen. Wenn die Datei mit der Übersicht auch in diesem Ordner ist, versucht er, diese zu öffnen, obwohl sie bereits geöffnet ist. Das führt zu einem Fehler, der das Makro automatisch beendet. Ich hab' für die Datei mit der Übersicht jetzt noch eine Prüfung eingebaut, die dieses Problem behebt. Ausserdem hab ich das Ganze noch ein bisschen übersichtlicher gestaltet. Prrobier das mal so aus.

Sub Uebersicht()
Dim fso As Object, fo As Object, f As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFolder("\\eyfps\home\Projektplanung\Projekte\Angebote 25_000€\06-2005\")
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each f In fo.Files
If Not f.Path = ThisWorkbook.FullName Then
With ThisWorkbook.Sheets(1)
Workbooks.Open (f.Path)
.Range("A65536").End(xlUp).Offset(1, 0) = _
Workbooks(f.Name).Sheets(2).Range("B2")
.Range("A65536").End(xlUp).Offset(0, 1) = _
Workbooks(f.Name).Sheets(2).Range("B3")
.Range("A65536").End(xlUp).Offset(0, 2) = _
Workbooks(f.Name).Sheets(2).Range("B4")
.Range("A65536").End(xlUp).Offset(0, 3) = _
Workbooks(f.Name).Sheets(2).Range("B5")
.Range("A65536").End(xlUp).Offset(0, 4) = _
Workbooks(f.Name).Sheets(2).Range("B7")
.Range("A65536").End(xlUp).Offset(0, 5) = _
Workbooks(f.Name).Sheets(2).Range("B8")
.Range("A65536").End(xlUp).Offset(0, 6) = _
Workbooks(f.Name).Sheets(2).Range("d2")
.Range("A65536").End(xlUp).Offset(0, 7) = _
Workbooks(f.Name).Sheets(2).Range("d3")
.Range("A65536").End(xlUp).Offset(0, 8) = _
Workbooks(f.Name).Sheets(2).Range("d4")
.Range("A65536").End(xlUp).Offset(0, 9) = _
Workbooks(f.Name).Sheets(2).Range("d5")
.Range("A65536").End(xlUp).Offset(0, 10) = _
Workbooks(f.Name).Sheets(2).Range("k3")
.Range("A65536").End(xlUp).Offset(0, 11) = _
Workbooks(f.Name).Sheets(2).Range("h9")
.Hyperlinks.Add Anchor:= _
.Range("A65536").End(xlUp).Offset(0, 12), _
Address:=f.Path, TextToDisplay:=f.Path
End With
End If
Workbooks(f.Name).Close False
Next f
Fehler:
Application.ScreenUpdating = True
End Sub

Gruß Ingolf
Anzeige
AW: @IngGI - Vielen Dank...!!!!!!!!
01.07.2005 11:18:11
Ingo
Hallo Ingolf,
bei Deinem neuen Code geht er nach (Anchor:= _) in der letzten Befehlszeile auf (.Range) und gibt folgende Fehlermeldung:
---------------------------
Microsoft Visual Basic
---------------------------
Fehler beim Kompilieren:
Unzulässiger oder unzureichender Verweis
---------------------------
OK Hilfe
---------------------------
Ist für mich eine Spur zu hoch, was das annähernd bedeuten könnte...
Vielen Dank für Hilfe....!
Gruß, Ingo
AW: @IngGI - Vielen Dank...!!!!!!!!
01.07.2005 12:26:26
IngGi
Hallo Ingo,
auf das .Range nach Anchor:= _ sollte er eigentlich gar nicht gehen können. Die drei Zeilen
.Hyperlinks...
.Range...
Address...
sind nämlich in Wirklichkeit eine Zeile, verbunden über die Unterstriche am Schluss der ersten beiden Zeilen. Schreib das Ganze mal in eine Zeile, also:
.Hyperlinks.Add Anchor:=.Range("A65536").End(xlUp).Offset(0, 12), Address:=f.Path, TextToDisplay:=f.Path
Gruß Ingolf
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige