Serienbrief aus Excel Datei drucken und mit Daten der Tabelle versehen

[wuffwuff2003]

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

[DF6GL]

Hallo,

siehe mal hier:

http://www.dbwiki.net/wiki/Datei:AccSampleAccessToExcel.zip

[wuffwuff2003]

Vielen Dank,
In Excel gab es ein Modul das sieht so aus: mit diesem Modul wurde das ganze dann gemacht:

Code [Auswählen] Erweitern

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


[wuffwuff2003]

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.

Code [Auswählen] Erweitern

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


[DF6GL]

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.

[wuffwuff2003]

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]

[wuffwuff2003]

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]

[DF6GL]

Hallo,

"schreibt das Beispiel mir eine neue Excel Datei. "


dann öffne doch anstatt  die Datei und mach keine neue.....

[wuffwuff2003]

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

[DF6GL]

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 ..............

[wuffwuff2003]

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.