Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
19.04.2024 13:49:38
Per Kopfdruck als pdf speichern und Mail erstellen
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1232to1236
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1232to1236
1232to1236
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro zum Einlesen

Makro zum Einlesen
WalterK
Hallo,
ich möchte Werte aus 12 geschlossenen Dateien einlesen. Dafür habe ich ein Tabellenblatt mit allen Pfadangaben vorbereitet. Per Klick auf einen Button sollten alle 12 Werte eingelesen werden. Die eingelesenen Werte sollen im Bereich E8:E19 stehen.
Sollte eine Pfadandresse nicht richtig sein, sollte Fehler eingetragen werden. Sollte nur die Datei nicht vorhanden sein, dann soll eine Null (0) eingetragen werden.
Bei jedem Klick auf den Button sollten alle Werte neu eingelesen werden.
Mit dem Makrorekorder komme ich nicht weiter, vielleicht kann mir hier jemand behilflich sein.
Anbei eine Beispieltabelle:
https://www.herber.de/bbs/user/76819.xls
Danke im voraus und Servus, Walter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro zum Einlesen
30.09.2011 20:58:36
Josef

Hallo Walter,
probier mal.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub readData()
  Dim rng As Range
  Dim strPath As String, strFile As String, strTab As String, strRef As String
  
  strPath = Range("A2").Text & Range("A5").Text
  
  strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
  
  strTab = Range("A22").Text
  
  strRef = Range("A25").Text
  
  If Dir(strPath, vbDirectory) = "" Then
    Range("D8:D19") = "Pfad nicht gefunden!"
  Else
    For Each rng In Range("A8:A19")
      If Dir(strPath & rng.Text, vbNormal) = "" Then
        rng.Offset(0, 3) = 0
      Else
        rng.Offset(0, 3) = GetValue(strPath, rng.Text, strTab, strRef)
      End If
    Next
  End If
  
End Sub


Private Function GetValue(path As String, file As String, _
    sheet As String, ref As String)
  '   Retrieves a value from a closed workbook
  Dim arg As String
  '   Make sure the file exists
  If Right(path, 1) <> "\" Then path = path & "\"
  
  If Dir(path & file) = "" Then
    GetValue = "File Not Found"
    Exit Function
  End If
  
  '   Create the argument
  arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
    Range(ref).Range("A1").Address(, , xlR1C1)
  
  '   Execute an XLM macro
  GetValue = ExecuteExcel4Macro(arg)
End Function



« Gruß Sepp »

Anzeige
Perfekt! Besten Dank und Servus, Walter
30.09.2011 21:11:50
WalterK

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige