[thanosgr]

Καλημέρα σε όλους

Μετέωρα: Εχω ανοίξει ενα κενό εγγραφο προτυπο. Αντέγραψα ενα text κειμενο και στα σημεία που ήθελα να στέλνει records απο την Access, πηγα Εισαγωγή, σελιδοδείκτες, και προσθήκη. μετά αποθήκευση σαν .dot, (εχω δοκιμασει και σαν dotx). .Ολα αυτά σε MS Word 2007.


nasos23: Tο εχω διπλοτσεκάρει, αλλα τίποτα δίνω και τον κωδικα παρακάτω

On Error GoTo HandleErr
Dim strFileName As String
Dim strsave As String
Dim rstSuppliers As DAO.Recordset


If IsNull(Me!PreorderID) Then
    
    var = MsgBox("Error", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
    Exit Sub
End If

var = MsgBox("Εκτύπωση;", vbYesNo + vbDefaultButton2 + vbQuestion, "Ðñïóï÷Þ")
If var = vbNo Then Exit Sub



Select Case Me!ApprovalText1
Case "0881"
    If IsNull(DLookup("[0811LabourWorkFilename]", "Settings")) Or DLookup("[0811LabourWorkFilename]", "Settings") = "" Then
        
        var = MsgBox("Ðáñáêáëþ êÜíôå Ýëåã÷ï åÜí õðÜñ÷åé ôï ðñüôõðï áñ÷åßï MS-Word", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
        Exit Sub
    Else
        strFileName = DLookup("[0811LabourWorkFilename]", "Settings")
    End If
'Case "1431"
'    If IsNull(DLookup("[1431WordTemplateFileName]", "Settings")) Or DLookup("[1431WordTemplateFileName]", "Settings") = "" Then
        
 '       var = MsgBox("Ðáñáêáëþ êÜíôå Ýëåã÷ï åÜí õðÜñ÷åé ôï ðñüôõðï áñ÷åßï MS-Word", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
 '       Exit Sub
 '   Else
  '      strFileName = DLookup("[1431WordTemplateFileName]", "Settings")
 '   End If
    
'Case "1611"
  '  If IsNull(DLookup("[1611WordTemplateFileName]", "Settings")) Or DLookup("[1611WordTemplateFileName]", "Settings") = "" Then
        
  '      var = MsgBox("Ðáñáêáëþ êÜíôå Ýëåã÷ï åÜí õðÜñ÷åé ôï ðñüôõðï áñ÷åßï MS-Word", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
   '     Exit Sub
  '  Else
     '   strFileName = DLookup("[1611WordTemplateFileName]", "Settings")
  '  End If
    
'Case Else
 '   If IsNull(DLookup("[OthersWordTemplateFileName]", "Settings")) Or DLookup("[OthersWordTemplateFileName]", "Settings") = "" Then
        
   '     var = MsgBox("Ðáñáêáëþ êÜíôå Ýëåã÷ï åÜí õðÜñ÷åé ôï ðñüôõðï áñ÷åßï MS-Word", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
    '    Exit Sub
  '  Else
       ' strFileName = DLookup("[OthersWordTemplateFileName]", "Settings")
        
    'End If
End Select


'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo HandleErr
appWord.Visible = False
WordTemplateFilePath = CurrentProject.Path & "\" & strFileName
If Dir$(WordTemplateFilePath) = "" Then
    
    var = MsgBox("Äåí âñÝèçêå ôï ðñüôõðï áñ÷åßï MS-Word" & vbCrLf & "Äåí ÂñÝèçêå " & WordTemplateFilePath, vbCritical + vbOKOnly, "Ðñïóï÷Þ")
    GoTo HandleErrExit
End If

Set doc = appWord.Documents.Add(WordTemplateFilePath)
With doc

    .FormFields("bmk1").Result = Nz(Me!InvoiceNumber, "")
    .FormFields("bmk2").Result = Format(Nz(Me!InvoiceDate, ""), "d mm yyyy")
    .FormFields("bmk5").Result = Format(Nz(Me!InvoiceDate, ""), "d mm yyyy")
    .FormFields("bmk4").Result = Nz(Me!NumberID, "")
    

    Strsql = "SELECT Supplier.SupplierName, Supplier.SupplierDescription, PreorderSuppliers.Qualify, PreorderSuppliers.Price"
    Strsql = Strsql & " FROM Supplier INNER JOIN (Preorder INNER JOIN PreorderSuppliers ON Preorder.PreorderID = PreorderSuppliers.PreorderID) ON Supplier.SupplierID = PreorderSuppliers.SupplierID"
    Strsql = Strsql & " WHERE Preorder.PreorderID = " & Me!PreorderID & " AND PreorderSuppliers.Qualify = True"
    
  
    Set rstSuppliers = CurrentDb.OpenRecordset(Strsql, dbOpenForwardOnly)
    If Not rstSuppliers.EOF Then
       .FormFields("bmk3").Result = Nz(rstSuppliers("SupplierName"), "")
       
    Else
       var = MsgBox("Ðáñáêáëþ êÜíôå Ýëåã÷ï åÜí õðÜñ÷åé ôï ðñüôõðï áñ÷åßï MS-Word", vbCritical + vbOKOnly, "Ðñïóï÷Þ")
       Exit Sub
    End If
     
     'strsave = Me!NumberID & "_" & rstSuppliers("SupplierName")
         
   ' .SaveAs FileName:="C:\Users\ÈáíÜóçò\Desktop\ÉÁÍÏÕÁÑÉÏÓ" & strsave
    
    
End With



appWord.Visible = True
appWord.Activate


HandleErrExit:
On Error GoTo 0
On Error Resume Next
rstSuppliers.Close
Set rstSuppliers = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
    MsgBox "Error " & Err & " : " & Error$, vbCritical, "Ðñïóï÷Þ"
    Resume HandleErrExit
End Select