Discussion :

[Thexs]

Bonjour,

Je débute le VBA et j'avoue ne pas réellement bien comprendre, je lis petit à petit les tutos pour y remédier, je fais donc des script par mimétisme et de nombreux essai jusqu'à réussite néanmoins cette fois si je sèche

Voici le 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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub EnregistrerNew()
 
 'Définition des variables
 Dim Nom As String
 Dim Nom2 As String
 Dim Nom3 As String
 Dim Fichier As String
 
 Fichier = ThisWorkbook.Path & "\" & Nom3
 Nom3 = "Modele" & ".xls"
 
 
 Nom = Range("A4") & ".xls"
 Nom2 = Range("A4") & ".pdf"
 
 If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
   SendKeys Nom
   Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
 Else
   If Range("A4") = "" Then MsgBox "Entrez le nom du fichier en A4", 48: Range("A4").Select: Exit Sub
   If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
     On Error Resume Next
     ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    If Err Then MsgBox "Fichier déjà existant", 48: Range("A4").Select
 
    'Fixe les cellules et sauvegarde à nouveau
    Range("A1:B3").Select
    Selection.Copy
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    'Crée le fichier PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Nom2, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=4, OpenAfterPublish:=False
 
    'Ferme le nouveau fichier sauvé
    ThisWorkbook.Close
 
   End If
 End If
 
 
    'Ouvrir le modèle
    Workbooks.Open (Fichier)
 
 End Sub

Malgré le codage pitoyable de la chose, la macro marche dans l'ensemble, seul le Workbooks.Open (Fichier) (Ligne 52) ne s’exécute pas, j'ai essayé plein d'autres alternative d'ouverture de fichier, toutes sans succès.
Note qui peut peut-être avoir son important, le fichier initial sur lequel la macro tourne est du Excel 97-2003 ouvert dans du Excel 2016

Merci d'avance pour votre aide,
J.

[Theze]

Bonsoir,

Il te faut savoir que le compilateur lit et exécute le code de haut en bas, chose que tu peux vérifier avec des appuis successifs sur la touche F8 et donc, pour ce qui concerne ces deux lignes :

Code :

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

1
2
3
 
 Fichier = ThisWorkbook.Path & "\" & Nom3
 Nom3 = "Modele" & ".xls"

comme tu initialises la variable "Nom3" après lui faire référence dans la variable "Fichier" comme à ce moment là elle est vide, dans le chemin il manque le nom du classeur, il te faut donc inverser ces deux lignes !

Code :

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

1
2
3
 
Nom3 = "Modele" & ".xls"
 Fichier = ThisWorkbook.Path & "\" & Nom3

Quand on utilise l'esperluette (&) c'est pour concaténer des chaînes de caractères et généralement dans des variables donc, ceci qui est écrit en "dur" : "Modele" & ".xls" peut être écrit : "Modele.xls"

[Thexs]

Merci pour ta réponse, malheureusement le bougre ne veut pas fonctionner voici la correction apportée d'après ta remarque

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub EnregistrerNew()
 
 'Définition des variables
 Dim Nom As String
 Dim Nom2 As String
 Dim Nom3 As String
 Dim Fichier As String
 
 Nom = Range("A4") & ".xls"
 Nom2 = Range("A4") & ".pdf"
 Nom3 = "Modele.xls"
 Fichier = ThisWorkbook.Path & "\" & Nom3

Je continue les tests ... =D

[unparia]

Bonjour

Encore une question de logique pure et élémentaire
Un classeur fermé est fermé. Et une fois fermé, les lignes de code d'instructions ne sont bien évidemment plus exécutées...
J'espère que tu ne vas pas me demander des explications à ce propos, hein ... Regarde la chronologie de tes instructions, s'il te plait.

[Thexs]

Bonsoir Unparia,

Ton raisonnement est en effet purement logique car l'exécution pas à pas ferme la feuille avant même d'arriver sur la dernière ligne de commande.
Je modifie ça.

Merci pour le conseil.

[Thexs]

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub EnregistrerNew()
 
 'Définition des variables
 Dim Nom As String
 Dim Nom2 As String
 Dim Nom3 As String
 Dim Fichier As String
 Dim wb As Workbook
 
 Nom = Range("A4") & ".xls"
 Nom2 = Range("A4") & ".pdf"
 Nom3 = "Modele.xls"
 Fichier = ThisWorkbook.Path & "\" & Nom3
 
 If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
   SendKeys Nom
   Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
 Else
   If Range("A4") = "" Then MsgBox "Entrez le nom du fichier en A4", 48: Range("A4").Select: Exit Sub
   If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
     On Error Resume Next
     ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    If Err Then MsgBox "Fichier déjà existant", 48: Range("A4").Select
 
    'Fixe les cellules et sauvegarde à nouveau
    Range("A1:B3").Select
    Selection.Copy
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    'Crée le fichier PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Nom2, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=4, OpenAfterPublish:=False
 
    Set wb = ActiveWorkbook
 
    'Ouvrir le modèle
    Workbooks.Open (Fichier)
 
    'Ferme le nouveau fichier sauvé
    wb.Close
 
   End If
 End If
 
 End Sub

... fausse pioche, le pas à pas n'exécute pas l'ouverture de "Fichier "...
Une idée ?

[unparia]

Merci pour le conseil

Ce n'était pas un "conseil", mais la dénonciation d'une aberration évidente.

Et que tu aies besoin d'essayer, pour la vérifier, m'effraie quelque peu ...

[unparia]

Une idée ?

Le chemin de ta variable Fichier n'est pas celui d'un classeur ou le classeur en cause n'est pas accessible (protégé, etc ...)

Je viens quand-même, pour acquis de conscience de faire ce test sur ma machinen depuis un classeur classeur1

Code :

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

1
2
3
Set wb = ActiveWorkbook
Workbooks.Open ("c:\classeur2.xlsm")
wb.Close

Aucun problème.

EDIT : j'attendais des remarques éventuelles à propos de "pour acquis" (qui n'est pas "par acquit"). Elles ne sont pas venues (dommage, car je me régalais d'avance ).

[Thexs]

Erreur trouvée.... le nom de l'extension .xls au lieu de .xlsm pour Nom3...

Au cas où ça sert à quelqu'un

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub EnregistrerNew()
 
 'Définition des variables
 Dim Nom As String
 Dim Nom2 As String
 Dim Nom3 As String
 Dim Fichier As String
 Dim wb As Workbook
 
 Nom = Range("A4") & ".xls"
 Nom2 = Range("A4") & ".pdf"
 Nom3 = "Modele.xlsm"
 Fichier = ThisWorkbook.Path & "\" & Nom3
 
 If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
   SendKeys Nom
   Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
 Else
   If Range("A4") = "" Then MsgBox "Entrez le nom du fichier en A4", 48: Range("A4").Select: Exit Sub
   If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
     On Error Resume Next
     ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    If Err Then MsgBox "Fichier déjà existant", 48: Range("A4").Select
 
    'Fixe les cellules et sauvegarde à nouveau
    Range("A1:B3").Select
    Selection.Copy
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
 
    'Crée le fichier PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Nom2, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=4, OpenAfterPublish:=False
 
    Set wb = ThisWorkbook
 
    'Ouvrir le modèle
    Workbooks.Open (Fichier)
 
    'Ferme le nouveau fichier sauvé
    wb.Close
 
   End If
 End If
 
 End Sub

Merci pour votre aide.
Bonne soirée