hallo zusammen,
gerne möchte ich nochmal eure hilfe in Anspruch nehmen :)
ich möchte einzelne bestimmte zellen aus einer Excel Tabelle in ein formular ziehen.
die exceltabelle muss zuvor in dem Formular ausgewählt werden (die Tabelle heisst immer unterschiedlich und liegt an versch. orten auf der fp). die exceltabelle selber ist IMMER gleich aufgebaut!
ich möchte quasi im Formular die Tabelle auswählen und dann sollen immer die zellen (z.b. A1, B3, C5) in die dazugehörigen Textfelder (z.b. Text1, Text2, Text3) übertragen werden.
könnt ihr mir helfen?
Hallo,
warum in das Formular uebernehmen?
Daten sollten in Tabellen gespeichert werden, die dann im Formular, ggf. ueber Abfragen, angezeigt werden.
Also ich wuerde die Daten in meine Tabelle uebernehmen und dann im Formular anzeigen lassen.
Oder was ist der Hintergrund diese direkt im Formular anzeigen lassen zu wollen?
Gruss
Jens
das Formular besteht aus mehreren datensätzen. in jedem dieser datensätze werden quasi immer die gleichen felder aus unterschiedlichen Excel-Tabellen eingelesen.
über das Formular mit den eingelesenen Daten wird ein bericht erstellt
formulardatensatz 1: Angebot Lieferant1; exceltabelle 1
formulardatensatz 2: Angebot Lieferant2; exceltabelle 2
formulardatensatz 3: Angebot Lieferant3; exceltabelle 3
im formular werden weitere Berechnungen durchgeführt
bericht aus den datensätzen: angebotsvergleich; sortiert nach: günstigster als erster
Ja, aber das einlesen der Daten aus dem Excel sollte oder wird in Tabellen erfolgen, oder?
Dan wie gesagt ueber ggf. Abfragen das Formular befuellen und am besten auch gleich die Berechnungen durchfuehren.
Dann aus dem Form einen Report erstellen.
Oder ich verstehe dich jetzt ganz falsch :-\.
Gruss
Jens
hallo Jens,
danke für deine nachricht
das formular ist gefiltert; es werden also nur die lieferanten (aus der lieferantentabelle) in dem formular gezeigt, die die anfrage erhalten haben.
HF: gefilterte lieferanten; UF: angefragter artikel (verknüpfte artikeltabelle)
genau in dem UF sollen die daten aus der exceltabelle; werden dort u.a. zu weiteren berechnungen verwendet und dann über einen button in die verknüpfte artikeltabelle dem lieferanten zugeordnet, abgespeichert.
ferner wird aus dem gefilterten formular ein bericht mit einer zusammenfassung der angebote generiert
Hallo!
Ich habe mir das mal so zusammengebastelt, feinschliff kommt noch aber vielleicht hilft dir weiter
Den ersten Code habe ich in einem extra Modul
Erst lese ich die relevanten Daten für die Haupttabelle aus und lege wen nötig einen Datensatz an
Die ID dann mit den Daten in die untergeordnete Tabelle also in deinen Fall das Unter Formular
Musst dir für deine Bedürfnisse anpassen, vielleicht kannst was damit anfangen
Option Compare Database
Option Explicit
Private Const mod_formModule As String = "mdl_Excel."
Private objExcel As Excel.Application
Public Property Get CreateExcel() As Excel.Application
On Error Resume Next
If objExcel Is Nothing Then
Set objExcel = New Excel.Application
If Err <> 0 Or objExcel Is Nothing Then
Err = 0
Set objExcel = New Excel.Application
If Err <> 0 Or objExcel Is Nothing Then
Beep
MsgBox "Verbindung zu Excel kann nicht aufgebaut werden. " & _
Err.Description, vbSystemModal + vbCritical Or vbOKOnly, "Problem !"
If Not objExcel Is Nothing Then Set objExcel = Nothing
Exit Property
End If
End If
End If
Set CreateExcel = objExcel
End Property
Public Function CreateExcel_Book(ByVal bolShow As Boolean, _
Optional ByVal strVorlage As String = "") As Excel.Workbook
Dim objBook As Excel.Workbook
'On Error GoTo Err_ErrHandler
If strVorlage <> "" Then
Set objBook = CreateExcel.Workbooks.Add(Template:=strVorlage)
objExcel.Visible = bolShow
If bolShow Then AppActivate objBook.Parent.ActiveWindow.Caption
Else
Set objBook = CreateExcel.Workbooks.Add
objExcel.Visible = bolShow
If bolShow Then AppActivate objBook.Parent.ActiveWindow.Caption
End If
Set CreateExcel_Book = objBook
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Vorlage konnte nicht geladen werden. " & _
Err.Description, vbSystemModal + vbCritical Or vbOKOnly, "Problem !"
Call LogError(Err.Number, Err.Description, mod_formModule & " CreateExcel_Book()", , False)
End If
Call ResetWord
Resume Exit_ErrHandler
End Function
Public Function CreateExcel_Open(ByVal bolShow As Boolean, _
ByVal strPfad As String) As Excel.Workbook
Dim objBook As Excel.Workbook
'On Error GoTo Err_ErrHandler
'call CreateExcel_Open (True,"C:\Users\Papa\Desktop\Zeiterfassung arbeitszeit_erfassen.xlsx")
Set objBook = CreateExcel.Workbooks.Open(strPfad)
objExcel.Visible = bolShow
'If bolShow Then AppActivate objBook.Parent.ActiveWindow.Caption
Set CreateExcel_Open = objBook
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Datei konnte nicht geladen werden. " & _
Err.Description, vbSystemModal + vbCritical Or vbOKOnly, "Problem !"
Call LogError(Err.Number, Err.Description, mod_formModule & " CreateExcel_Open()", , False)
End If
Call ResetWord
Resume Exit_ErrHandler
End Function
Public Function ResetExcel(Optional ByVal bolOpen As Boolean = False) As Boolean
On Error Resume Next
Select Case bolOpen
Case True
If Not objExcel Is Nothing Then Set objExcel = Nothing
Case False
objExcel.Quit
If Not objExcel Is Nothing Then Set objExcel = Nothing
End Select
End Function
Public Function Excel_Zeiterfassung_EM() As Boolean
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim rst As DAO.Recordset
Dim i As Integer
Dim z As Integer
Dim lngID As Long
Dim lngMID As Long
Dim lngJahr As Long
Dim lngMonat As Long
Dim strBookPfad As String
Dim strSQL As String
'On Error GoTo Err_ErrHandler
strBookPfad = fncDateiauswahl("wählen Sie die Zeiterfassung", akt_Verz_Desktop, "Excel")
If Len(strBookPfad) > 0 Then
Set objBook = CreateExcel_Open(True, strBookPfad)
Set rst = CurrentDb.OpenRecordset("tbl_Arbeitszeit_Details", dbOpenDynaset)
If Not objBook Is Nothing Then
For i = 1 To 12
z = 6
Set objSheet = objBook.Worksheets(i)
With objSheet
.Select
.Unprotect Password:="*****"
lngMID = .Cells(4, 8).Value
lngMonat = .Cells(3, 10).Value + 1
lngJahr = fncYear_ID(objSheet.Cells(4, 10).Value)
If Nz(DLookup("ABZ_ID", "tbl_Arbeitszeit", "ABZ_M_IDRef = " & lngMID & " And ABZ_Monat_IDRef = " & lngMonat & " And ABZ_Jahr_IDRef = " & lngJahr), 0) > 0 Then
lngID = CurrentDb.OpenRecordset("SELECT ABZ_ID From tbl_Arbeitszeit" & _
" WHERE ABZ_M_IDRef = " & lngMID & "" & _
" And ABZ_Monat_IDRef = " & lngMonat & "" & _
" And ABZ_Jahr_IDRef = " & lngJahr).Fields(0)
Else
strSQL = "INSERT INTO tbl_Arbeitszeit (ABZ_M_IDRef, ABZ_Monat_IDRef, ABZ_Jahr_IDRef)" & _
" VALUES ( " & lngMID & " , " & lngMonat & ", " & lngJahr & ")"
CurrentDb.Execute (strSQL), dbFailOnError
lngID = CurrentDb.OpenRecordset("SELECT @@IDENTITY").Fields(0)
End If
For z = 6 To .UsedRange.Rows.Count
If .Cells(z, 2).Value = "xxx" Then Exit For
If .Cells(z, 11).Value = "x" Then
rst.AddNew
rst.Fields("ABZ_Detais_Auf_IDRef") = lngID
rst.Fields("ABZ_Detais_Tag_Von") = CInt(.Cells(z, 3).Value)
rst.Fields("ABZ_Detais_Zeit_Von") = Format(.Cells(z, 4).Value, "hh:nn")
rst.Fields("ABZ_Detais_Tag_Bis") = CInt(.Cells(z, 5).Value)
rst.Fields("ABZ_Detais_Zeit_Bis") = Format(.Cells(z, 6).Value, "hh:nn")
rst.Fields("ABZ_Detais_Pause_Min") = Format(.Cells(z, 7).Value, "hh:nn")
rst.Fields("ABZ_Detais_Absenz_Art_IDRef") = DLookup("ABZ_Absenz_Art_ID", "tbl_Arbeitszeit_Status_Art", "ABZ_Absenz_Art_Bez = '" & objSheet.Cells(z, 9).Value & "'")
rst.Fields("ABZ_Detais_Bemerkung") = .Cells(z, 10).Value
rst.Update
.Cells(z, 2).Value = "Eingelesen"
End If
Next
.Protect Password:="*****", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Next
objBook.Save
End If
End If
Exit_ErrHandler:
If Not rst Is Nothing Then rst.Close: Set rst = Nothing
If Not objBook Is Nothing Then Set objBook = Nothing
If Not objSheet Is Nothing Then Set objSheet = Nothing
Call ResetExcel
Exit Function
Err_ErrHandler:
Select Case Err.Number
Case 3022 'Fängt Indiziertes feld ab / Doppelte eingabe
Resume Next
Case Else
Call LogError(Err.Number, Err.Description, mod_formModule & " Excel_Zeiterfassung_EM()", , False)
End Select
Resume Exit_ErrHandler
End Function
@Frank77:
Daaaaankeeeeeeee!
Probier ich aus
Hallo!
Gibt auch noch was in die Richtung, aber da kenn ich mich nicht aus
https://msdn.microsoft.com/en-us/vba/access-vba/articles/docmd-transferspreadsheet-method-access
Gruß Frank