Discussion :

[grisan29]

bonjour a vous tous
depuis la discussion
http://www.developpez.net/forums/d12...leurs-valeurs/
je n'ai fait que remplacer des lignes de codes c'est un peu mieux mais reste une erreur 1004 de plusieures solutions
donc voici ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub nouvellefeuille_Click()
Dim shFact As Worksheet, shNew As Worksheet, wbNew As Workbook
Set shFact = Sheets("Facturation")
Set shNew = Sheets.Add
 Dim Mot As String
 Dim nom, chemin As Variant
 
shFact.Cells.Copy
shNew.Range("A1").PasteSpecial xlPasteValues
shNew.Range("A1").PasteSpecial xlPasteFormats
 
shNew.Move
nom = Sheets("facturation").Range("D17").Value & "-" & Sheets("facturation").Range("J5").Value & ".xls"
chemin = "C:\Save_Devis_ExcelGStock\Devis"
 
ActiveWorkbook.SaveAs Filename:=chemin & nom, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
 
If [MTTC].Row - 9 > 19 Then
    shFact.Range("C19:C" & [MTTC].Row - 9).EntireRow.Delete
ElseIf [MTTC].Row - 9 = 19 Then
    shFact.Range("C19").EntireRow.Clear
End If
shFact.Range("J5:J8").ClearContents
shFact.Range("C16").ClearContents
Select Case UCase(shFact.Range("D1"))
    Case Is = "FACTURE"
        Range("S7") = Range("S7") + 1
    Case Is = "DEVIS"
        Range("S8") = Range("S8") + 1
End Select
 
End Sub

sachant que "C:\Save_Devis_ExcelGStock\est le dossiers d'archivage et dans lequel il y a des sous dossiers "devis et facture"
si vous avez une réponse a me donner car je planche dessus depuis un moment

cordialement

Pascal

[kiki29]

Salut, déjà, sans aller plus loin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim nom As String, chemin As String
 
...Filename:=chemin & "\" & nom

, après c'est toujours le même drame du copier/coller d'un code non maitrisé.

[grisan29]

Bonjour kiki29
merci des rectifications que j'ai appliqué mais cela ne changent pas
toujours la meme ligne qui rentre en défaut soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nom = Sheets("facturation").Range("D17").Value & "-" & Sheets("facturation").Range("J5").Value & ".xls"

et le code rectifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub nouvellefeuille_Click()
Dim shFact As Worksheet, shNew As Worksheet, wbNew As Workbook
Set shFact = Sheets("Facturation")
Set shNew = Sheets.Add
 Dim Mot As String
 Dim nom, chemin As String
 
shFact.Cells.Copy
shNew.Range("A1").PasteSpecial xlPasteValues
shNew.Range("A1").PasteSpecial xlPasteFormats
 
shNew.Move
nom = Sheets("facturation").Range("D17").Value & "-" & Sheets("facturation").Range("J5").Value & ".xls"
filename: chemin = "C:\Save_Devis_ExcelGStock\Devis"
 
ActiveWorkbook.SaveAs filename:=chemin & "\" & nom, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
 
If [MTTC].Row - 9 > 19 Then
    shFact.Range("C19:C" & [MTTC].Row - 9).EntireRow.Delete
ElseIf [MTTC].Row - 9 = 19 Then
    shFact.Range("C19").EntireRow.Clear
End If
shFact.Range("J5:J8").ClearContents
shFact.Range("D17").ClearContents
Select Case UCase(shFact.Range("D1"))
    Case Is = "FACTURE"
        Range("S7") = Range("S7") + 1
    Case Is = "DEVIS"
        Range("S8") = Range("S8") + 1
 
End Select
 
End Sub

Pascal

[mercatog]

Si la feuille facturation appartient au classeur contenant ton code, fais comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
With ThisWorkbook.Worksheets("facturation")
    nom = .Range("D17").Value & "-" & .Range("J5").Value & ".xls"
End With

Quand tu fais, ShNew.move, tu as un nouveau classeur avec une seule feuille et devient classeur actif.

Ta ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nom = Sheets("facturation").Range("D17").Value & "-" & Sheets("facturation").Range("J5").Value & ".xls"

Provoquera une erreur (à moins que shNew s'appelle facturation)

Aussi, est tu sûr que D17 et J5 ne contiennent pas de caractères interdits tels que :/?!

[grisan29]

bonsoir Mercatog

D14 est formule comme ci

devis N° 2012-08-125

et 125 est incrémenté a chaque nouvelle feuille
autrement J5 est le nom du client en majuscule sans signe

je vais essayer ce que tu propose et je reviens

Pascal

je viens d'essayer mais pas mieux mais peut etre que ce que tu soulève est le problème "shnew'
s'il faut les remplacer par autre chose je ne sais pas
depuis le temps que je fait des essais je ne me suis pas pencher sur ce problème et ce code a du m'etre fait en meme temps et bizarrement fonctionner

Pascal

[mercatog]

Je viens de tester le début du code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub NouvelleFeuille_Click()
Dim Mot As String, Nom As String, Chemin As String
Dim shFact As Worksheet, shNew As Worksheet
 
Set shFact = ThisWorkbook.Worksheets("Facturation")
Set shNew = Sheets.Add
 
shFact.UsedRange.Copy
shNew.Range("A1").PasteSpecial xlPasteValues
shNew.Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
 
Nom = shFact.Range("D17").Value & "-" & shFact.Range("J5").Value & ".xls"
Chemin = "C:\Save_Devis_ExcelGStock\Devis"
 
shNew.Move
ActiveWorkbook.SaveAs filename:=Chemin & "\" & Nom, FileFormat:=xlExcel8
 
 
End Sub

[grisan29]

bonsoir Mercatog

merci pour ta solution que je ne peux essayer pour l'instant

il vient d'y avoir une mise a jour automatique et depuis le redémmarrage j'ai un massagevba qui apparait a tous mes fichiers excel de mon cru ou pas
ce message vba dit

erreur compilation (erreur 440)
erreur automation

clic sur ok et ouverture vba avec des lignes en jaune qui fonctionnais avant cette mise a jour
je crois que je fait faire une restauration a moins que tu saches de quoi il sagit

cordialement

Pascal

[mercatog]

Regarde par hasard les références dans ton éditeur vba si tu n'as pas MANQUANT

[grisan29]

bonsoir

ole automation est présent, mais qui serait marqué Manquant

Pascal

[mercatog]

Décoche là

[grisan29]

bonjour Mercatog

j'ai décochez la réference "ole automation" , j'ai fermé le fichier pour voir et un message s'est affiché me disant que le document n'est pas enregistrer

je vais essayer ce week end sur mon portable
Pascal

[grisan29]

bonjour a vous

c'est nouveau et voici un apercu du débogage

Pascal

[grisan29]

bonjour Mercatog

j'ai fait une restauration a 5 jours et pareil donc annulé, puis aujourdhui desinstallé office 2007 ,effacer les anciennes données dans la base de registre et cela est reparti correctement pour l'instant bon au sujet du code il bug a la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Nom, FileFormat:=xlExcel8

et j'ai intégré ton code comme ceci, le panneau qui s'affiche marque bien le n°du devis et le nom du client car la feuil1 est a leur nom avec l'extension

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub NouvelleFeuille_Click()
Dim Mot As String, Nom As String, Chemin As String
Dim shFact As Worksheet, shNew As Worksheet
 
Set shFact = ThisWorkbook.Worksheets("Facturation")
Set shNew = Sheets.Add
 
shFact.UsedRange.Copy
shNew.Range("A1").PasteSpecial xlPasteValues
shNew.Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
 
Nom = shFact.Range("D17").Value & "-" & shFact.Range("J5").Value & ".xls"
Chemin = "C:\Save_Devis_ExcelGStock\Devis"
 
shNew.Move
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Nom, FileFormat:=xlExcel8
 
 
If [MTTC].Row - 9 > 19 Then
    shFact.Range("C19:C" & [MTTC].Row - 9).EntireRow.Delete
ElseIf [MTTC].Row - 9 = 19 Then
    shFact.Range("C19").EntireRow.Clear
End If
shFact.Range("J5:J8").ClearContents
shFact.Range("C16").ClearContents
Select Case UCase(shFact.Range("D1"))
    Case Is = "FACTURE"
        Range("S7") = Range("S7") + 1
    Case Is = "DEVIS"
        Range("S8") = Range("S8") + 1
 
End Select
 
End Sub

voila ce que je peux dire apres tous ces déboires

cordialement

Pascal

[mercatog]

Tu as bien ce dossier?
"C:\Save_Devis_ExcelGStock\Devis"

[grisan29]

Bonjour Mercatog

oui j'ai bien "C:\Save_Devis_ExcelGStock" dans lequel il y les sous-dossier "Devis" et "Facture"
j'ai meme essayer en mettant"C:\Save_Devis_ExcelGStockA" et pareil

Pascal

je viens d'installé le code sur le meme fichier sur le portable et le fichier s'est bien enregistrer mais a laissé la feuille créer en supplément sur le fichier

Pascal

[mercatog]

Bon, j'ai testé chez moi le code (légèrement modifié pour la clarté) sans problèmes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub NouvelleFeuille_Click()
Dim Mot As String, Nom As String, Chemin As String
Dim shNew As Worksheet
 
Chemin = "C:\Save_Devis_ExcelGStock\Devis"
 
If Dir(Chemin, vbDirectory) <> "" Then
    With ThisWorkbook.Worksheets("Facturation")
        Set shNew = Sheets.Add
        .UsedRange.Copy
        shNew.Range("A1").PasteSpecial xlPasteValues
        shNew.Range("A1").PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
 
        shNew.Move
        Set shNew = Nothing
        Nom = .Range("D17").Value & "-" & .Range("J5").Value & ".xls"
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=Chemin & "\" & Nom, FileFormat:=xlExcel8
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
 
        .Range("J5:J8", "C16").ClearContents
        If .[MTTC].Row - 9 > 19 Then
            .Range("C19:C" & .[MTTC].Row - 9).EntireRow.Delete
        ElseIf .[MTTC].Row - 9 = 19 Then
            .Rows(19).Clear
        End If
 
        Select Case UCase(.Range("D1"))
            Case Is = "FACTURE"
                .Range("S7") = .Range("S7") + 1
            Case Is = "DEVIS"
                .Range("S8") = .Range("S8") + 1
        End Select
    End With
End If
End Sub

[grisan29]

bonjour

ben la il n'y a plus rien a comprendre l'appui sur le bouton n'a plus d'action

Pascal

[mercatog]

J'ai édité le code (j'avais oublié de supprimer mon chemin pour le test)
Mais apparemment, tu devais t'en rendre compte

Revois le code édité

[grisan29]

bonjour

hormis

Chemin = "C:\Users\user\Desktop"

et

.UsedRange.Copy

je ne vois mais en les mettant en commentaire c'est le code qui se copie en feuil1

Pascal

[mercatog]

Tu n'arrives pas à adapter et comprendre le code. Mets ton fichier en pj