Private Sub BnImpFiche_Click()
On Error GoTo Erreur_Proc
Dim MonFic As String
' Initialisation de l'environnement
MonRep = LireIni("REPERTOIRES", "Base")
If Right(MonRep, 1) <> "\" Then MonRep = MonRep & "\"
MonFic = MonRep & "_FicheOuvCLT.xls"
MaBase = MonRep & NomBase
Dim xlApp As Object
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Workbooks.Open (MonFic)
' Affiche le document
.Visible = True
.CommandBars("Standard").Visible = True
.CommandBars("Formatting").Visible = True
' Instancier la feuille active dans le classeur
Set sht = .ActiveWorkbook.ActiveSheet
' Compléter la feuille excel
sht.Range("H17").Value = Me.Demandeur
Select Case Me.CltType
Case "Particulier"
sht.Range("B20").Value = "X"
sht.Range("B21").Value = ""
sht.Range("B22").Value = ""
Case "Privé"
sht.Range("B20").Value = ""
sht.Range("B21").Value = "X"
sht.Range("B22").Value = ""
Case "Public"
sht.Range("B20").Value = ""
sht.Range("B21").Value = ""
sht.Range("B22").Value = "X"
End Select
' Le nom du client
sht.Range("B25").Value = Nz(Me.CltNom1, "")
sht.Range("B26").Value = Nz(Me.CltNom2, "")
' L'adresse du client
sht.Range("B27").Value = Nz(Me.CltAdr1, "")
sht.Range("B28").Value = Nz(Me.CltAdr2, "")
' Le code postal + la ville
sht.Range("B29").Value = Nz(Me.CltCodePTT, "")
sht.Range("B30").Value = Nz(Me.CltVille, "")
' Le télephone + le fax
sht.Range("B32").Value = Nz(Me.CltTel, "")
sht.Range("B33").Value = Nz(Me.CltFax, "")
' Le numéro de siret
sht.Range("B35").Value = Nz(Me.CltSiret, "")
' Le code APE
sht.Range("B38").Value = Nz(Me.CltCodeAPE, "")
' On sauvegarde le fichier
.ActiveWorkbook.SaveAs (PathFic & "FOC " & Me.CltNom1 & ".xls")
If MsgBox("Voulez-vous réellement imprimer la Fiche d'Ouverture Client ?", _
vbQuestion + vbYesNo, "QUESTION ...") = vbYes Then
.ActiveWorkbook.PrintOut
End If
.ActiveWorkbook.Close
End With
Exit_Erreur:
xlApp.Quit
Set xlApp = Nothing
Exit Sub
Erreur_Proc:
MsgBox Err.Description & vbCrLf & "Inscription dans fichier 'ErrorLog.txt'"
LogError Err, Me.Name, "Sub TabRécap_Click()"
Resume Exit_Erreur
End Sub