Rompre lien entre deux fichiers Excel

Le 24/08/2015 à 10:41

Bonjour à tous,

Comme le titre l'indique, j'ai un problème pour rompre les liens sur un fichier Excel, j'ai essayé pas mal de code trouvé sur internet en les adaptant à mon problème mais c'est sans résultat...

Mon code pour le moment fonctionne correctement, je veux juste les valeurs sans les formules, donc le plus simple je pense que c'est de rompre le lien..(Je précise que je ne peux pas faire un collage spécial).

Je reste ouvert si vous avez d'autres solutions.

Le code est le suivant :

'Envoie du pdf au client
doc = CH & "\" & A & "\" & M & "\" & "2620-" & CStr(Year(Date)) & "-" & [D14].Value & ".pdf"

Dim Sh, nSh As Worksheet
Dim nWb As Workbook
Dim aApp, aMail As Object
Dim FilePath As String

Set Sh = ThisWorkbook.Sheets("EWR") 'choisir la bonne feuille
Set nWb = Workbooks.Add()
Set nSh = nWb.Sheets(1)
Set aApp = CreateObject("Outlook.Application")
Set aMail = aApp.CreateItem(0)
Application.ScreenUpdating = False
Sh.Cells.Copy nSh.Range("A1:H51")
FilePath = ThisWorkbook.Path 'Choisir un path (peu importe lequel puisqu'on écrase le fichier à la fin)..
nWb.SaveAs Filename:="EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value 'On sauvegarde une copie.

doc2 = FilePath & "\" & A & "\" & M & "\" & "EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value & ".xlsx"
 With aMail
 .to = [G9].Value ' destinataires
       .Subject = "Devis " & LCase([D16].Value)    'Sujet
       .Body = "Bonjour M." & [L1].Value & "," & Chr$(10) & Chr$(10) & "Veuillez trouver ci-joint notre devis pour les travaux : " & LCase([D16].Value) & " , bonne réception." & Chr$(10) & Chr$(10) & "Cordialement, " & Chr$(10) & "Joffrey" 'Corps du mail
       .Attachments.Add doc2  'attachment pdf
       .Attachments.Add doc
       .Display 'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
    End With
  nWb.Close 'On ferme le fichier...
 Kill doc2 'et on le détruit

En espérant que vous allez pouvoir trouver une solution pour moi et en vous remerciant.

Cordialement,

Julien.

Le 24/08/2015 à 18:16

Hello,

As-tu essayé la méthode BreakLink de l'objet Workbook ?

https://msdn.microsoft.com/fr-fr/library/office/ff194915.aspx

Le 25/08/2015 à 07:14

Oui j'avais en effet essayé, mais ça ne devait pas être exactement le même code car le lien y était toujours...

Mais maintenant ça fonctionne, je te remercie

Je mets le code au cas où ça intéresserait quelqu'un 

'Envoie du pdf au client
    doc = CH & "\" & A & "\" & M & "\" & "2620-" & CStr(Year(Date)) & "-" & [D14].Value & ".pdf"

Dim Sh, nSh As Worksheet
Dim nWb As Workbook
Dim aApp, aMail As Object
Dim FilePath As String

Set Sh = ThisWorkbook.Sheets("EWR") 'choisir la bonne feuille
Set nWb = Workbooks.Add()
Set nSh = nWb.Sheets(1)
Set aApp = CreateObject("Outlook.Application")
Set aMail = aApp.CreateItem(0)
Application.ScreenUpdating = False
Sh.Cells.Copy nSh.Range("A1:H51")
FilePath = ThisWorkbook.Path 'Choisir un path (peu importe lequel puisqu'on écrase le fichier à la fin)..
nWb.SaveAs Filename:="EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value 'On sauvegarde une copie.

Workbooks("EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value).Activate
 ' Define variable as an Excel link type.
 astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
 ' Break the first link in the active workbook.
 ActiveWorkbook.BreakLink _
 Name:=astrLinks(1), _
 Type:=xlLinkTypeExcelLinks
Workbooks("EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value).Save

doc2 = FilePath & "\" & A & "\" & M & "\" & "EWR Devis 2620-" & CStr(Year(Date)) & "-" & [D14].Value & ".xlsx"
 With aMail
 .to = [G9].Value ' destinataires
       .Subject = "Devis " & LCase([D16].Value)    'Sujet
       .Body = "Bonjour M." & [L1].Value & "," & Chr$(10) & Chr$(10) & "Veuillez trouver ci-joint notre devis pour les travaux : " & LCase([D16].Value) & " , bonne réception." & Chr$(10) & Chr$(10) & "Cordialement, " & Chr$(10) & "Joffrey" 'Corps du mail
       .Attachments.Add doc2  'attachment pdf
       .Attachments.Add doc
       .Display 'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
    End With
  nWb.Close 'On ferme le fichier...
 Kill doc2 'et on le détruit

Merci encore

Cordialement,

Julien.

Rechercher des sujets similaires à "rompre lien entre deux fichiers"