Dabei ist jeder Spalte in der Database-Tabelle einem anderen Wert auf der zu importierenden Excel zugeordnet.
Als Bsp.
Die Database Tabelle, in denen schon Daten stehen, sollen durch eine ausgewählte Excel .xlsm Datei ergänzt werden. Durch click auf den Button kann ich den Dateipfad auswählen und danach wird ergänzt.
Name | Code | Strom | Last |
Bsp1 1234 56 30
Bsp2 5678 28 15
Import1 Import2 Import3 Import4
Dabei ist jeder Import eine andere Zelle ggf. auch anderes Worksheet:
Import1 = Worksheet(1´te von links) Zelle D6
Import2 = Worksheet(4´te von links) Zelle J4
Import3 = Worksheet(6´te von links) Zelle BE19
Import4 = Worksheet(6´te von links) Zelle BF19
Die Zellen im Arbeitsblatt ändern sich nie, da es sich immer um die gleiche Vorlage handelt die importiert wird!
Nach dem Import kann ich die Importfunktion wiederholen und meine Datenbank durch den Import von weiteren Daten ergänzen, sprich die nächsten Daten in einer Zeile weiter unten schreiben.
Ich habe dazu mal einige Codes probiert und versucht umzuschreiben, aber nicht hinbekommen.
Sub GetFilePath()
Dim pfad As String
FilePath = Application.GetOpenFilename("Excel-Arbeitsmappe mit Makros(*.xlsm), *.xlsm")
If FilePath False Then
Set pfad = FilePath
End If
End Sub
___________________________________________________________________
Sub Zelle_auslesen1()
'** Dimensionierung der Variablen
blatt As String, zelle As String
'** Angaben zur auszulesenden Zelle
blatt = "Blatt 1"
bezug = "D6"
'** Eintragen in Zelle
ActiveCell.Value = GetValue(blatt, bezug)
End Sub
___________________________________________________________________
Private Function GetValue(pfad, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Vielen Dank für Eure Hilfe.Grüße Chris