Copie de feuilles et liaisons

[yvantof]

Bonjour le Forum !

N'ayant pas de succès avec le fil "décomposition de formules" (je vais poster un exemple de fichier plus simple sur ce fil), je vous propose un autre problème.

J'ai récupéré un code sympa permettant de sauvegarder une feuille d'un classeur.
Cependant j'ai 3 problèmes.

1/ J'aimerais que le format d'enregistrement contienne aussi des lettres et signes.
Par ex TFC1000/29092007 au lieu de 100029092007
2/ La feuille est copiée dans "mes documents" ce qui ne m'arrange pas !
Je souhaiterai plutot définir un dossier.
3/ La feuille est toujours liée au fichier de départ et je voudrais simplement rompre les liaisons après que la feuille soit copiée;

ci-dessous le code.

Sub SAVEFORMUL()
'
' SAVEFORMUL Macro
' Macro enregistrée le 29/09/2007 par ANDRE
'
Dim Nomfichier As String, Entree As String
Dim f As Worksheet 'déclare la variable f
Dim fich As Workbook
Dim lerep
lerep = ActiveWorkbook.Path
Début:
Entree = InputBox("Please select number of formulae : for example N° TFC and date : 1250010108 ")
If Len(Entree) = 10 And IsNumeric(Entree) Then
Nomfichier = Left(Entree, 4) & "_" & Right(Entree, 6)
With Application.FileSearch
.NewSearch
.LookIn = lerep
.Filename = Nomfichier & ".xls"
.MatchTextExactly = True
.Execute
FileExists = .FoundFiles.Count = 1
If FileExists Then
MsgBox "This formulae already exist ! Please select an other name": GoTo Début
End If
End With
ActiveSheet.Copy
For Each obj In ActiveSheet.Shapes
obj.Delete
Next
ActiveWorkbook.SaveAs Filename:=Nomfichier & ".xls"
ActiveSheet.Name = Nomfichier
Msg = "Your fourmulae has been saved in the format (TFC)xxxx/date"
Title = "SAVE FORMULAE"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(Msg, Style, Title)
ActiveWorkbook.Close (False)
Else
MsgBox "BAD FORMAT, Please try again": GoTo Début
End If
End Sub

Merci pour votre aide !

 

[fred65200]

Re : Copie de feuilles et liaisons

Je viens de réessayer et chez moi ça marche, plus de liaison.
Je te joins le code, change juste la racine, je n'ai pas noté ton chemin

Sub SAVEFORMUL()
'
' SAVEFORMUL Macro
' Macro enregistrée le 29/09/2007 par ANDRE
'
Dim Nomfichier As String, Entree As String
Dim f As Worksheet 'déclare la variable f
Dim fich As Workbook
Dim lerep
lerep = ActiveWorkbook.Path
Dim racine
racine = "C:\Users\Fred\Desktop\"
Début:
Entree = InputBox("Please select number of formulae (4 numbers)")
If Len(Entree) = 4 And IsNumeric(Entree) Then
Entree = InputBox("Please select a date (DDMMYYYY")
If Len(Entree) = 8 And IsNumeric(Entree) Then
Nomfichier = "TFC" & Left(Entree, 4) '& "make on " & Right(Entree, 8)

''     With Application.FileSearch
''        .NewSearch
''        .LookIn = lerep
''        .Filename = Nomfichier & ".xls"
''        .MatchTextExactly = True
''        .Execute
''        FileExists = .FoundFiles.Count = 1
''    If FileExists Then
''    MsgBox "This formulae already exist ! Please select an other name": GoTo Début
''    End If
''    End With
    ActiveSheet.Copy
    For Each obj In ActiveSheet.Shapes
        obj.Delete
    Next
  For Each Nom In ActiveWorkbook.Names
    Nom.Delete
  Next
ActiveWorkbook.SaveAs Filename:=racine & Nomfichier & ".xls" 'm", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveSheet.Name = Nomfichier
    Msg = "Your fourmulae has been saved in the format TFCxxxx/date"
    Title = "SAVE FORMULAE"
    Style = vbOKOnly + vbInformation
    Reponse = MsgBox(Msg, Style, Title)
    
    ActiveWorkbook.Close (False)
       
    
    Else
MsgBox "BAD FORMAT, Please try again": GoTo Début

MsgBox "BAD FORMAT, Please try again": GoTo Début
End If
End If

End Sub

 

[fred65200]

Re : Copie de feuilles et liaisons

Modifie aussi la ligne
Nomfichier = "TFC" & Left(Entree, 4) '& "make on " & Right(Entree, 8)
en
Nomfichier = "TFC" & Left(Entree, 4) & "make on " & Right(Entree, 8)

Je l'ai zappée celle là

J'ai aussi mis toute la procédure de recherche en commentaire

Fred65200

 

[yvantof]

Re : Copie de feuilles et liaisons

Rien à faire cela ne fonctionne pas: la copie est toujours liée.
Y a des jours comme ça ...

 

[fred65200]

Re : Copie de feuilles et liaisons

On va y arriver
Ajoute

Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues

avant d'enregistrer sous
ActiveWorkbook.SaveAs Filename:=racine & Nomfichier & ".xls"

il y avait encore des liaisons dans certaines formules

Tiens moi au courant, je reste encore en ligne 1/2 h

@+

 

[yvantof]

Re : Copie de feuilles et liaisons

Ca a marché cette fois !
Plus aucune liaison sur la feuille.

Merci d'avoir persévéré ainsi.

Yvantof

 

[pierrejean]

Re : Copie de feuilles et liaisons

bonjour aux noctambules

bravo a fred

ci joint une autre version qui offre l'avantage de preserver les formules non concernées par le fichier lié (ex colonne F)