Discussion :

[Pexou]

Bonjour a tous,

Je viens vers vours pour terminer un bout de 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
55
56
57
58
59
60
61
62
63
64
65
66
Private Sub CBEnregistrerDemandeActivite_Click()
 
Dim oExcel As excel.Application
Dim oWk As Workbook
Dim adresse As String
Dim dest As Range
Dim OutlookApp As New Outlook.Application
Dim NewMail As Outlook.MailItem
 
  If TBdemandeur = "" Or TBFinActivite = "" Or TBImputation = "" Or TBprojet = "" Or TBNbreElement = "" Then
  MsgBox "Saisissez tous les champs obligatoire", , "Information"
  Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
Label10.Visible = True
Label11.Visible = True
Exit Sub
End If
 
  adresse = "\\MonRepertoire"
 
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False 'Masque l'application excel (valeur par défaut)
    On Error Resume Next 'Pour éviter les erreur si classeur n'existe pas
    Set oWk = oExcel.Workbooks.Open(adresse & "\Info Activités ACTXXXX-XXX.xlsx")
    On Error GoTo 0
    If oWk Is Nothing Then
      MsgBox "Erreur sur ouverture classeur fichier inexistant ", vbCritical
      Exit Sub
    End If
 
    Set dest = Sheets("feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
    dest.Offset(0, 2).Value = TBdemandeur
       dest.Offset(0, 4).Value = TBFinActivite
          dest.Offset(0, 5).Value = TBImputation
             dest.Offset(0, 6).Value = TBprojet
                dest.Offset(0, 7).Value = TBCommentaire
                   dest.Offset(0, 8).Value = TBNbreElement
 
 
 
 
 
    MsgBox " Merci, Votre demande a été enregistrée et un email a été envoyé au responsable ", , "Demande Effectuée"
 
 
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    NewMail.Recipients.Add ("email.fr")
    NewMail.Subject = "Demande Activité"
    NewMail.Body = TBdemandeur & " souhaite la prise en charge du projet " & " '' " & TBprojet & " '' " & vbNewLine & _
               "" & vbNewLine & _
               "" & vbNewLine & _
               "" & TBCommentaire
    NewMail.Send
 
        'Sauve le classeur
    oWk.Save
    oWk.Close False 'Ferme le classeur
    oExcel.Quit
    Set oWk = Nothing
    Set oExcel = Nothing 'libération mémoire..
 
 
Unload DemandeActivite
  Unload Executable_Technologue_YQMC
End Sub

J’ai plusieurs problèmes :
1- Quand mon fichier a été enregistré Excel ne se ferme pas dans le « processus » ce qui occasionne souvent des erreurs par la suite quand je souhaite enregistrer un autre fichier !
Y a-t-il une méthode pour résoudre ce problèmes ? ( dans mon cas pour le resoudre je dois fermer tout mon programme c'est-à-dire «

Code :

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

 Unload Executable_Technologue_YQMC

»

2- Je souhaiterai créer un dossier directement lors de la sauvegarde du fichier qui s’incrémenterai a chaque fois.
Je vous explique :
Lors de l’enregistrement de la saisi dans le « FORM »,, il ouvre excel de manière cacher enregistre puis le ferme, j’aimerai a ce moment la qu’il me crée undossier qui s’agrémenterai vis-à-vis des autres déjà existant avec la nomenclature « ACT2013-001 » « ACT2013-002 ».
Je ne sais pas realiser d’incrementation par VB !veuillez men escusez !!

Cordialement

pex

[Oliv-]

Salut,
Si j'ai bien compris ton fichier EXCEL est toujours le même.
Mais à chaque ajout tu veux créer un dossier correspondant à l'ajout ?

A parti de quel programme est exécuté ton formulaire ?

[Pexou]

Salut,
Si j'ai bien compris ton fichier EXCEL est toujours le même.
Mais à chaque ajout tu veux créer un dossier correspondant à l'ajout ?

A parti de quel programme est exécuté ton formulaire ?

Le fichier excel est créer suite a un formulaire ( qui utilise une trame constante) mais a chaque fois qu'il enregistre je veux creer un repertoire avec l'incrementation. Ce numero est important pour le suivi des pieces realiser.Le repertoire n'est pas au meme endroit que le fichier il se situe dans un sous dossier apres !!

je sais pas si tu vois se que je veux dire !

[Oliv-]

donc c'est un nouveau fichier excel et un nouveau dossier que tu veux créer ?

[Pexou]

donc c'est un nouveau fichier excel et un nouveau dossier que tu veux créer ?

juste un nouveau dossier, car le fichier excel c'est juste une saisi de donnée qui va directement dedans c'est toujours le meme fichier excel ! par contre je veux qu'un dossier se creer automatiquement a chaque nouvelle saisi s'incrémentant !

merici de maider

[Oliv-]

Alors pour Excel, il vaut mieux utiliser ADODB pour écrire dans le fichier fermé, bien que ton code semble fermer correctement le fichier et Excel.

Pour vérifier l'existence d'un dossier tu peux utiliser dir et MkDir pour le créer.

Code :

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

1
2
3
If "" = Dir("c:\temp\EDI\", vbDirectory) Then
            MkDir "c:\temp\EDI\"
        End If

Sinon regarde FSO qui peut être fort utile

[Pexou]

Alors pour Excel, il vaut mieux utiliser ADODB pour écrire dans le fichier fermé, bien que ton code semble fermer correctement le fichier et Excel.

Pour vérifier l'existence d'un dossier tu peux utiliser dir et MkDir pour le créer.

If "" = Dir("c:\temp\EDI\", vbDirectory) Then
MkDir c:\temp\EDI\"
End If


Sinon regarde FSO qui peut être fort utile

Oui mais comment utiliser MkDir en incrémentant le nom du dossier?

[Oliv-]

Quelle est ta règle d'incrémentation ?

Soit tu as l'info quelque par de ton dernier DOSSIER , par exemple dans ton fichier Excel (code sur dernier ligne renseignée ou dans un champs spécifique)
soit tu parcours tout ton dossier parent et tu cherches le numéro le plus grand (avec FSO) pour trouver le nouveau.

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
 
Sub test_parcours_dossiers()
    parcours_dossiers "D:\Temp\VBE"
End Sub
 
Sub parcours_dossiers(strFolderName As String)
    Dim FSO As Object
    Dim oSourceFolder As Object
    Dim oFolder As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = FSO.GetFolder(strFolderName)
    NewNumber = 0
 
    For Each oFolder In oSourceFolder.subfolders
 
        On Error Resume Next
        If CDbl(Right(oFolder.Name, 3)) > NewNumber Then
            NewNumber = CDbl(Right(oFolder.Name, 3))
        End If
 
    Next oFolder
 
    NewDossier = "ACT2013-" & Right("000" & CStr(NewNumber) + 1, 3)
    MsgBox NewDossier
 
End Sub

[Pexou]

Quelle est ta règle d'incrémentation ?

Soit tu as l'info quelque par de ton dernier DOSSIER , par exemple dans ton fichier Excel (code sur dernier ligne renseignée ou dans un champs spécifique)
soit tu parcours tout ton dossier parent et tu cherches le numéro le plus grand (avec FSO) pour trouver le nouveau.

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
 
Sub test_parcours_dossiers()
    parcours_dossiers "D:\Temp\VBE"
End Sub
 
Sub parcours_dossiers(strFolderName As String)
    Dim FSO As Object
    Dim oSourceFolder As Object
    Dim oFolder As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oSourceFolder = FSO.GetFolder(strFolderName)
    NewNumber = 0
 
    For Each oFolder In oSourceFolder.subfolders
 
        On Error Resume Next
        If CDbl(Right(oFolder.Name, 3)) > NewNumber Then
            NewNumber = CDbl(Right(oFolder.Name, 3))
        End If
 
    Next oFolder
 
    NewDossier = "ACT2013-" & Right("000" & CStr(NewNumber) + 1, 3)
    MsgBox NewDossier
 
End Sub

j'ai une erreur a ce niveau la :

Code :

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

    Set oSourceFolder = FSO.GetFolder(strFolderName)

erreur d'éxécution 76 : chemin d'acces introuvable
mon incrémentation est de ce type : ACT2013-00X ou X est la variable de type +1.

Si mon dernier dossier est ACT2013-015, je veux qu'il crée ACT2013-016



merci de ton aide !!

[Pexou]

j'ai une erreur a ce niveau la :

Code :

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

    Set oSourceFolder = FSO.GetFolder(strFolderName)

erreur d'éxécution 76 : chemin d'acces introuvable
mon incrémentation est de ce type : ACT2013-00X ou X est la variable de type +1.

Si mon dernier dossier est ACT2013-015, je veux qu'il crée ACT2013-016



merci de ton aide !!

en faites cela marche parfaitement désolé , j'ai retouché un peu ton code est maintenant c'est niquel !
si je pouvais je vous paierai lapero

Cordialement

pex