Hallo
Ich versuch mal das Problem zu beschreiben: Ich habe eine Liste mit Mitarbeiter die verschiedene Tätigkeiten haben. Diese werden durch verschiedene Abfragen je Tätigkeit ausgewählt. Nun habe ich einen Schichtplan den ich immer im Excel bekomme. Dieser muss dann so oft ausgedruckt werden wie Mitarbeiter da sind. Aber je Tätigkeit ändert sich auch der Schichtplan. Access soll nun per Knopfdruck eine komplette Tätigkeit ausdrucken, und zusätzlich den Namen der in Access in der Tabelle (Abfrage dieser Tätigkeit) steht auf das Excel Blatt übertragen (je Name ein Blatt), so dass man nachher jedem Mitarbeiter seinen persönlichen Schichtplan überreichen kann. Ist sowas machbar? Wenn ja , denke ich mal geht das bestimmt nur über VBA oder? Den 2. Button startet dann das Gleiche für Tätigkeit 2 z.B.
Vielen Dank
Hallo,
siehe mal hier:
http://www.dbwiki.net/wiki/Datei:AccSampleAccessToExcel.zip
Vielen Dank,
In Excel gab es ein Modul das sieht so aus: mit diesem Modul wurde das ganze dann gemacht:
Option Explicit
Public Choix As Byte
Public NomCRM As String
Public NumCase As String
Public Function Druck(NomTS, Pathnom)
Dim Ende As Long
Dim x As Integer
Dim Nomstr As String
Dim NomRLT As String
Dim NomSheet As String
Dim Colum_nr As Integer
Dim Row_nr As Integer
Dim bExists As Boolean
Dim oWorkbook As Object
Dim wrksht As Worksheet
Dim Filenom As String
Dim Pos As Integer
Dim Tot As Integer
Dim w As Object
Tot = Len(Pathnom)
Pos = InStrRev(Pathnom, "\")
Pos = Tot - Pos
Filenom = Right$(Pathnom, Pos)
' Prüfen ob Datei bereits geöffnet ist
bExists = False
With Application
For Each oWorkbook In .Workbooks
If (oWorkbook.Name) = Filenom Then
' Jetzt aktivieren
Windows(oWorkbook.Name).Activate
bExists = True
Exit For
End If
Next
End With
' Mappe neu laden!
If Not bExists Then
On Error Resume Next
Workbooks.Open Filename:=Pathnom, ReadOnly:=False
On Error GoTo 0
End If
On Error GoTo Error_Druck
Select Case NomTS
Case "TS11"
NomSheet = "RLT01 à RLT31"
NomRLT = "R11"
Colum_nr = 16
Case "TS12"
NomSheet = "RLT01 à RLT31"
NomRLT = "R12"
Colum_nr = 20
Case "TS13"
NomSheet = "RLT01 à RLT31"
NomRLT = "R13"
Colum_nr = 24
Case "TS21"
NomSheet = "RLT01 à RLT31"
NomRLT = "R21"
Colum_nr = 28
Case "TS22"
NomSheet = "RLT01 à RLT31"
NomRLT = "R22"
Colum_nr = 32
Case "TS23"
NomSheet = "RLT01 à RLT31"
NomRLT = "R23"
Colum_nr = 36
Case "TS31"
NomSheet = "RLT01 à RLT31"
NomRLT = "R31"
Colum_nr = 40
Case "TSsect"
NomRLT = "Rsect"
Colum_nr = 0
Case "TS1"
NomSheet = "RLT01 à RLT31"
NomRLT = "R01"
Colum_nr = 4
Case "TS2"
NomSheet = "RLT01 à RLT31"
NomRLT = "R02"
Colum_nr = 8
Case "TS3"
NomSheet = "RLT01 à RLT31"
NomRLT = "R03"
Colum_nr = 12
Case "TS14"
NomSheet = "RLT01 à RLT31"
NomRLT = "R14"
Colum_nr = 44
Case "TS15"
NomSheet = "RLT01 à RLT31"
NomRLT = "R15"
Colum_nr = 48
Case "TS16"
NomSheet = "RLT01 à RLT31"
NomRLT = "R16"
Colum_nr = 52
Case Else
End Select
'Pour un nom ou pour le rlt
frm_select.Show
If Choix = 0 Then
Exit Function
ElseIf Choix = 1 Then
Ende = 6
End If
Workbooks("RLT.xls").Activate
With Worksheets(NomSheet)
If Choix = 2 Then
Ende = .Cells(Rows.Count, Colum_nr).End(xlUp).Row
End If
End With
'impression
For x = 6 To Ende
Workbooks("RLT.xls").Activate
If Choix = 1 Then
Nomstr = NomCRM & " Rlt.: " & Worksheets(NomSheet).Cells(x, Colum_nr + 1).Value & " Case: " & NumCase
Else
Nomstr = Worksheets(NomSheet).Cells(x, Colum_nr).Value & " Rlt.: " & Worksheets(NomSheet).Cells(x, Colum_nr + 1).Value & " Case: " & Worksheets(NomSheet).Cells(x, Colum_nr + 2).Value
End If
Workbooks(Filenom).Activate
With Worksheets(NomTS).PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Worksheets(NomTS).PageSetup.PrintArea = "$A$3:$P$65"
With Worksheets(NomTS).PageSetup
.LeftHeader = "&""Times New Roman,Gras Italique""&48CFL - Ptc"
.CenterHeader = "&16" & Nomstr
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.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
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Worksheets(NomTS).PrintOut Copies:=1, Collate:=True
Next x
Workbooks(Filenom).Close savechanges:=False
Exit_Druck:
Exit Function
Error_Druck:
MsgBox Err.Number & " " & Err.Description, vbOKOnly, "Message du logiciel"
Resume Exit_Druck
End Function
Public Function Filepicker(Filename)
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
.AllowMultiSelect = False
.Title = " Sélectionnez le document pour l'imprimage:"
.Filters.Clear
.Filters.Add "TSCOPIE_date.xls", "*.xls"
'Ok-Button
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
Filename = vrtSelectedItem
Next vrtSelectedItem
'Cancel-Button
Else
Set fd = Nothing
Exit Function
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Function
Der 1. Schritt wäre mal denke ich dass Access mir den richtigen Sheet öffnet: Dazu hab ich folgenden VBA, nun fehlt mir die Definition des Sheets.
Private Sub Befehl0_Click()
Dim Pfad As String
Dim sFile As String
Pfad = "P:\data\bureau dlt1\CFL CRM T1\DISTRIBUTION TDS\"
sFile = Dir$(Pfad & "TSCOPIE*.xls")
If Len(sFile) > 0 Then
DateiOeffnen "open", Pfad & sFile & NomSheet, 3
Else
MsgBox "Datei TSCOPIE* nicht vorhanden", vbCritical
End If
End Sub
und warum nimmst Du nicht die vorgeschlagene Beispieldatei und sorgst damit erst mal dafür, dass die Daten übergeben werden. Ausdrucken kann man das Ding hinterher immer noch mit dem Übernehmen der "Druckbefehle" aus dem von Dir geposteten Code.
Also das problem ist folgendes , das Beispiel ist sehr gut das könnte ich übernehmen nur schreibt das Beispiel mir eine neue Excel Datei. Ich bekomme aber eine Datei, setze sie in den Anhang, die besteht aus Sheets, je nachdem welchen Knopf in Access ich drücke müsste dieses Sheet aufgehen. Nun soll in dieses Dokument, oben eine Zeile hinzugeschrieben werden, mit dem Namen des Mitarbeiters und dessen Schranknummer. Diese Daten übernimmt Access wie in der Beispieldatei aus der Abfrage.
[Anhang gelöscht durch Administrator]
Hier im Anhang sind mal beide Dateien wie es jetzt funktioniert. Die RLT hab ich , die TSCOPIE bekomme ich immer. Dann öffne ich die RLT drücke z.B. die Taste TS11 dann such ich mir die TSCOPIE Datei, dann die Gelbe Schaltfläche und es kommt zum Drucker raus. So müsste es auch aus Access heraus gehen. Also die RLT Datei würde dann wegfallen, und diese Buttons aus der RLT Datei stünden im Formular von Access, und die Daten die in der RLT stehen, würden aus der passenden Abfrage gewählt werden.
Vielleicht können Sie dann hinter mein Vorhaben blicken.
[Anhang gelöscht durch Administrator]
Hallo,
"schreibt das Beispiel mir eine neue Excel Datei. "
dann öffne doch anstatt die Datei und mach keine neue.....
Die Datei làsst sich zwar öffnen aber wie setzt man ihm dann den Befehl hinzu , den passenden Sheet noch zu öffnen. ?
Wenn Sie sich mein Beispiel mal ansehen, sehen die wie ich es meine, es lässt sich ganz schlecht hier so erklären. Mfg
Hallo,
dieser Excel-Code ist nicht 1:1 in Access verwendbar, es müssen die richtigen Referenzen auf das Excel-Objekt in Access gesetzt werden.
Statt der Add-Methode ist eben Open-Methode einzusetzen:
.Workbooks.Open ..............
Ja das ist schade dass sich der Code nicht so übernehmen lässt, denke ich bleibe dann lieber bei der Excel Sache, denn so gut bin ich im VBA nicht damit ich den auf das Access umgeschrieben bekomme. Da fehlen mir definitiv die Kenntnisse.