Bonjour,
je reviens vers vous concernant un projet qui normalement était clos mais dont je viens de voir un dysfonctionnement
Dans l'entreprise où je bosse il y a 2 version d'excel : 2003 et 2007
J'ai crée 2 fichiers avec macro qui sont en lien, grace a excel 2007: Tableau d'enregistrement et formulaire mais enregistré en format .xls ( c'est important pour la suite!!!)
Le programme consiste a transferer des données du tableau vers le formulaire via macro dans le tableau et ensuite le formulaire est envoyé en PJ via une autre macro qui est dans le formulaire par mail via Lotus
Quand l'expediteur et le destinataire du mail sont en excel 2007 il y a pas de probleme tout fonctionne
Par contre si le destinataire est en 2003 lorsqu'il ouvre la PJ, le fichier est comme "codé" il est rempli de caractere au lieu d'avoir le formulaire.
Je precise bien que tous les fichiers sont en .xls
Donc je m'en remet a vous car là je seche totalement
Si besoin je mets ci dessous tous les codes par contre ne me demandez pas les fichiers les données sont confidentiel.
Merci par avance car je suis vraiment decouragé
Code dans le fichier "Tableau"
	
	
	
	
	
		
	
	
	
	
	
		
Code dans le fichier "Formulaire"
	
	
	
	
	
		
	
	
	
	
	
		
	
	
	
	
	
		
	
		
			
		
		
	
				
			je reviens vers vous concernant un projet qui normalement était clos mais dont je viens de voir un dysfonctionnement
Dans l'entreprise où je bosse il y a 2 version d'excel : 2003 et 2007
J'ai crée 2 fichiers avec macro qui sont en lien, grace a excel 2007: Tableau d'enregistrement et formulaire mais enregistré en format .xls ( c'est important pour la suite!!!)
Le programme consiste a transferer des données du tableau vers le formulaire via macro dans le tableau et ensuite le formulaire est envoyé en PJ via une autre macro qui est dans le formulaire par mail via Lotus
Quand l'expediteur et le destinataire du mail sont en excel 2007 il y a pas de probleme tout fonctionne
Par contre si le destinataire est en 2003 lorsqu'il ouvre la PJ, le fichier est comme "codé" il est rempli de caractere au lieu d'avoir le formulaire.
Je precise bien que tous les fichiers sont en .xls
Donc je m'en remet a vous car là je seche totalement
Si besoin je mets ci dessous tous les codes par contre ne me demandez pas les fichiers les données sont confidentiel.
Merci par avance car je suis vraiment decouragé
Code dans le fichier "Tableau"
		Code:
	
	
	Private Sub TransfertFormulaire_Click()
Call Transfert
ThisWorkbook.Close SaveChanges:=True
End Sub
	
		Code:
	
	
	Sub Transfert()
Dim classeurSource As Workbook, classeurDestination As Workbook
Dim plg As Byte, x As Byte
Dim lig As Integer
Dim chemin As String
chemin = ThisWorkbook.Path & "\"
Set classeurSource = ThisWorkbook
lig = ActiveCell.Row
On Error Resume Next
x = Len(Workbooks("Formulaire-test.xls").Name)
If x = 0 Then
Set classeurDestination = Application.Workbooks.Open(chemin & "Formulaire-test.xls")
Else: Set classeurDestination = Workbooks("Formulaire-test.xls")
End If
On Error GoTo 0
With classeurDestination.Sheets("FOR0015")
plg = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("G7") = classeurSource.Sheets("Feuil1").Range("A" & lig)
    .Range("C8") = classeurSource.Sheets("Feuil1").Range("B" & lig)
    .Range("A21") = classeurSource.Sheets("Feuil1").Range("E" & lig)
    .Range("B21") = classeurSource.Sheets("Feuil1").Range("D" & lig)
    .Range("E21") = classeurSource.Sheets("Feuil1").Range("G" & lig)
    .Range("F21") = classeurSource.Sheets("Feuil1").Range("F" & lig)
    
  Select Case UCase(classeurSource.Sheets("Feuil1").Range("C" & lig))
        Case Is = "LCQ": .Range("C10") = "X"
        Case Is = "AQ": .Range("C12") = "X"
        Case Is = "LRD": .Range("C14") = "X"
        Case Is = "AR": .Range("C16") = "X"
        Case Is = "BE": .Range("C18") = "X"
    End Select
  
    
End With
End Sub
	Code dans le fichier "Formulaire"
		Code:
	
	
	Private Sub EnvoyerMail_Click()
Dim extension As String
Dim chemin As String, nomfichier As String
extension = ".xls"
chemin = "C:\Documents and Settings\TECHNICI\Bureau\Fichier\"
nomfichier = ActiveSheet.Range("G7") & extension
bExist = (Dir(chemin & nomfichier) <> "")
If bExist = False Then
Call Send_Active_Sheet
Call Archiver
Else
Call Archiver
End If
End Sub
	
		Code:
	
	
	Option Explicit
 
Const EMBED_ATTACHMENT As Long = 1454
'Chemin d'enregistrement du fichier temporaire'
Const stPath As String = "C:\Documents and Settings\TECHNICI\Bureau"
'Message dans le mail'
Const vaMsg As Variant = "Bonjour," & vbCrLf & vbCrLf & vbCrLf & "Voici le formulaire" & vbCrLf & vbCrLf & "Cordialement"
                                                                             
Dim bExist As Boolean
'Rajoute mail en copie
Const vaCopyTo As Variant = "XX@XX.com"
Sub Send_Active_Sheet()
 
  Dim stFileName As String
  Dim vaRecipients As Variant
  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object
  Dim stAttachment As String
  
  'Copie la feuille active dans un classeur temporaire'
  With ActiveSheet
    .Copy
    stFileName = .Range("G7").Value
  End With
 
  stAttachment = stPath & "\" & stFileName & ".xls"
 
  'Sauvegarde et ferme le classeur temporaire
  Application.DisplayAlerts = False
   With ActiveWorkbook
   .SaveAs stAttachment
    .Close
  End With
  Application.DisplayAlerts = True
 
  'Création de la liste des destinataires
  'Pour envoi a plusieurs personnes,mettre l'ensemble des mails entre parentheses separé par ,'
  'Ex : ("toto@mail.com","tata@mail.com".....)'
  vaRecipients = VBA.Array("XX@XX.fr")
  
  'Preparation de Lotus Notes
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GetDatabase("", "")
 
  'Ouverture de la fenetre d'identification de Lotus si pas ouvert.
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 
  'Creation du mail et de la piece jointe.
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
 
  'Ajout de propriétés au mail crée.
  With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    '.CopyTo = vaCopyTo
    .Subject = stFileName
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
 
  'supprime le classeur temporaire.
  Kill stAttachment
 
  'Supprime objet de la memoire.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
 
  MsgBox "Email crée et envoyé avec succès", vbInformation
End Sub
	
		Code:
	
	
	Sub Archiver()
Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer, bOuvre As Boolean
    Application.ScreenUpdating = False
    ThisWorkbook.ActiveSheet.Copy
    extension = ".xls"
    'chemin d'enregistrement du fichier
    chemin = "C:\Documents and Settings\TECHNICI\Bureau\Fichier\"
    nomfichier = ActiveSheet.Range("G7") & extension
    bExist = (Dir(chemin & nomfichier) <> "")
     If bExist Then
        bOuvre = (MsgBox(PROMPT:="un fichier de ce nom existe déjà, l'ouvrir ?", Buttons:=vbYesNo) = vbYes)
        ActiveWorkbook.Close False
        If bOuvre Then Workbooks.Open Filename:=chemin & nomfichier
    Else
    Application.DisplayAlerts = False
            With ActiveWorkbook
            .SaveAs Filename:=chemin & nomfichier
            .Close
        End With
        Application.DisplayAlerts = True
    End If
End Sub
	
			
				Dernière édition: