Sauvegarde non effectuée

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

16/08/2012, 02h42
kiki29
Salut, déjà, sans aller plus loin :
Code:

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é.

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:

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

et le code rectifié

Code:

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

16/08/2012, 18h46
mercatog
Si la feuille facturation appartient au classeur contenant ton code, fais comme ceci
Code:

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:

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 :/?!
16/08/2012, 20h04
grisan29

bonsoir Mercatog

D14 est formule comme ci

Citation:

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

Je viens de tester le début du code

Code:

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

16/08/2012, 22h07
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
16/08/2012, 22h27
mercatog

Regarde par hasard les références dans ton éditeur vba si tu n'as pas MANQUANT
16/08/2012, 22h42
grisan29

bonsoir

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

Pascal
17/08/2012, 00h15
mercatog

Décoche là
17/08/2012, 08h36
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
17/08/2012, 10h53
grisan29

bonjour a vous

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

Pascal

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:

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:

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

18/08/2012, 13h31
mercatog

Tu as bien ce dossier?
"C:\Save_Devis_ExcelGStock\Devis"
18/08/2012, 15h20
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

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

Code:

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

18/08/2012, 15h52
grisan29

bonjour

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

Pascal
18/08/2012, 16h02
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é
18/08/2012, 16h28
grisan29

bonjour

hormis

Citation:

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

et

Citation:

.UsedRange.Copy

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

Pascal
18/08/2012, 17h17
mercatog

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

Voir 40 message(s) de cette discussion en une page