Programmer avec vba et excel 2007

Version imprimable

11/11/2014, 15h13
logaiete

Programmer avec vba et excel 2007

Bonjour,

Je vais commencer à programmer sur vba excel.

il faut construire une application pour gérer les-actifs appartenant à votre société. Ces actifs sont classés par catégorie. Chaque catégorie a un nom, une durée vie (allant entre 1 et 15 ans) et un type d'amortissement (pour rendre votre application plus facile, vous pouvez simplement accepter l'amortissement linéaire en premier lieu).
La première feuille de calcul du fichier contient la liste unique de types d'avoirs fixes (voir fig. 1 en pièce jointe), et un bouton pour lancer votre application.

Comment commencer ? J'ai le packoffice (2007 : Excel ,word,...) et visual studio 2013. Dois je installer un nouveau programme dans mon packOffice pour créer cette application.Avez vous un exemple concret pour débuter cette programmation
11/11/2014, 19h39
parmi

Bonjour,

Le mieux serait de t'acheter un manuel de débutant.
Aucun pack nécessaire. Il suffit de taper Alt-F11 dans Excel pour aller créer du code, sinon utiliser l'enregistreur de macro dans l'onglet Développeur...
11/11/2014, 19h49
logaiete

Salut,

Je vais acheter le manuel.Mais Juste connaitriez vous de tutos qui pourrez me permettre d'attaquer plus rapidement.
Je suis déjà développeur donc vite fait quelques exemples et quelques methodes me permettra de commencer déjà.

Merci
11/11/2014, 20h38
SfJ5Rpw8

Bonsoir,

tu as un lien au bas du forum : TUTORIELS EXCEL
11/11/2014, 20h57
logaiete

Bonsoir,

J'ai vu plein de tutos.c'est bien je vais y plonger.

N'avez pas un petit exemple d'une feuille Excel qui pourrai illustrer la programmation de UsersForms pour commencer
pour me permettre de me lancer.

Merci.
11/11/2014, 21h40
parmi

Fais le tour du forum et regarde les messages qui ont des fichiers attachés (xls ou xlsm)
Certains pourraient te donner des idées selon le thème de la question.
11/11/2014, 21h49
logaiete

Bonsoir,

Je suis un nouveau dans le forum,pourrais tu m’aiguiller un peu pour la récupération d'un fichier exemple et me l'attacher en pièce jointe afin de voir.
Comment commencer.Et si je comprends bien ,je n'aurai pas à installer un nouveau soft ,mais que seulement dans excel aller dans l'onglet développeur pour commencer

Merci
11/11/2014, 23h24
parmi

Quand tu es dans Excel, tape Alt-F11 et tu te retrouveras dans l'environnement de programmation (VBE)

Quand tu te promènes dans le forum, regarde les posts qui peuvent t'intéresser avec un trombone (fichier inclus dans un message)
Lis les messages pour voir si ça peut t'intéresser et regarde le ou les fichiers qui sont joints à certains de ces messages.

Mais commence par aller dans le VBE et essayer de comprendre l'environnement.
Le langage n'est pas trop compliqué pour la base.

Dans l'onglet Développeur, tu as la possibilité d'enregistrer les choses que tu fais dans ton fichier: copier des cellules, les coller en valeur, écrire des formules,...
Quand tu arrêtes la macro, un code t'est fourni gracieuseté de cet enregistreur.
Il te reste à essayer de comprendre ce qui est écrit et, éventuellement, à y faire un peu de ménage.
11/11/2014, 23h30
logaiete

Bonsoir,

Merci pour ces précisions de démarrage.

Je vais me plonger dans les posts du forums et regarder.

Commencer déjà avoir la création des userforms et la gestion des événements.

je vous tiens au courant de la suite
11/11/2014, 23h34
parmi

Pour créer un Userform, tu vas dans le menu Insérer du VBE et choisis Userform.
Il y a une boîte d'outils de base de disponible à laquelle tu peux ajouter d'autres contrôles si besoin.
Tu places/dimensionnes les contrôles que tu veux.
Chaque contrôle a sa liste d'événements propre à lui.

Pour l'afficher en mode "run", tu écris

Code:

Userform1.show ' en changeant Userform1 par le nom que tu lui as donné si c'est le cas
14/11/2014, 21h38
logaiete

Bonjour les amis,

Sur mon appli ici de gestion des immobilistions en VBA Excel(voir fichier en pièce jointe et capture d'écrans UserForm),

J'ai besoin de réaliser ceci mais je bloque vu que je commence en VBA Excel:

But de l'exercice :

1- construire une application pour gérer les-actifs appartenant à votre société .
Ces actifs sont classés par catégorie. Chaque catégorie a un nom, une vie (allant entre 1 et 15 ans) et un type d'amortissement (pour rendre l' application plus facile, on utilise simplement l'amortissement linéaire en premier lieu).

Dans le classeur excel en pièce jointe :

Feuille 1 nommée fichier-type_avoir : donne la liste unique de types d'avoirs fixes avec un bouton A mettre pour lancer l'application
Feuille 2 nommée fichier-actifs immobilisés : donne la liste de tous les actifs ( Tous les actifs sont achetés sur un 1er Janvier (avec une clôture des comptes au 31 Décembre). En conséquence, tous les amortissements sont calculés sur une base année pleine.)
Feuille 3 nommée fichier-resume-immobilisation : contient un résumé du fichier-immobilisations, regroupés par type. Pour chaque type, le tableau montre la valeur brute, le total des amortissements et la valeur nette à la fin de la période en cours.

Ce qu'il faut faire

1. L'utilisateur peut naviguer à travers plusieurs userforms facilement, et n'a pas besoin d'exécuter des macros manuellement (Figure 4 voir capture d'écran);

2. Ajout de nouveaux types d'actifs (Figure 5 voir capture d'écran);

3. Ajout de nouveaux éléments dans le fichier-actifs fixes (Figure 6 voir capture d'écran);

4. Si l'utilisateur le demande (en cochant une 'case'), après la création d'un nouvel élément dans le fichier-actifs fixes, le calendrier complet de la dépréciation du nouvel élément est créé dans une nouvelle feuille de calcul (avec, pour chaque période , la valeur au début, la dépréciation et la valeur à la fin de la période).

5. Il est possible d'importer un fichier-actifs fixes (format .csv). Le contenu précédent du fichier des immobilisations est retiré.

Quelqu'un peut me guider surtout pour la création de ce model de UserForms avec des fieldSet
14/11/2014, 22h10
Invité

1 pièce(s) jointe(s)
Bonsoir,
pour créer un formulaire c'est comme Visual Studio 2013.

tu double click sur un contrôle tu entre dans l’éventement.

maintenant je ne sais pas si tu développe en C# ou VB.NET.

si tu programme en VB.NET fais pareil tu auras une palanquée d'erreurs mais tu trouveras aisément. les module de classe sont différant mais avec un niveau en .net on s'adapte facilement.

Code:

dim TOTO as string="Bof"
Code:

1 2 dim toto as string toto="Bof"
Code:

dim R as range=cells(1,1)
Code:

1 2 dim R as range set r=cells(1,1)
14/11/2014, 22h19
logaiete

Salut rdurupt,

Merci.

Mon soucis se trouve surtout à connecter les éléments sans passer par des macros.Par exemple au niveau de button start (Figure 1)

il passe ensuite à la figure 4 qui donne ces buttons de choix.Je veux juste un exemple de code qui me permet de switcher avec des fonctions de click sur ces boutons pour passer vers un de ce userform .

Par exemple un exemple de code qui dans mon bouton start application(lors de son click) me permet de basculer vers un userform avec un bouton Add a new category et le click sur ce bouton m'ouvre la UseForm me permettant de remplir la UserForm Add a new Category
14/11/2014, 22h32
Invité

2 pièce(s) jointe(s)
d'une certaine manière tu passeras par des macros!
click droit sur le bouton

comment tu ferais?
Code:

1 2 Form1 frm=new Form1(); frm.Show();
Code:

1 2 dim frm as Form1=new Form1() frm.Show()
Code:

1 2 3 dim frm as Form1 set Form1=new Form1 frm.Show
14/11/2014, 22h43
logaiete

merci rdurupt,c'est vraiment ce que je voulais.

Par contre il faudra passer toujours par des macros malgré ces contraintes ????

1. L'utilisateur peut naviguer à travers plusieurs userforms facilement, et n'a pas besoin d'exécuter des macros manuellement (Figure 4 voir capture d'écran);

2. Ajout de nouveaux types d'actifs (Figure 5 voir capture d'écran);

3. Ajout de nouveaux éléments dans le fichier-actifs fixes (Figure 6 voir capture d'écran);

Comment faire passer de la figure 4 à la figure 5,je pense qu'il faudra faire une fonction click button qui devra ouvrir le userForm correspondant.

Peux tu me guider avec une capture d'écran et code le mécanisme de passage de la figure 4 lors du click sur le bouton Add a new category
et le UserForm Add a new category Correspondant
14/11/2014, 22h52
Invité

ne te démonte pas ton expérience dans ton langage de prédilection que tu trouve sans doute facile te perturbe pour VBA.

je viens de te démontrer que la syntaxe est différente mais l’esprit est le même.

analyse ta problématique comme dab , la syntaxe suivra!

je t'es donné quelque clé, C# VB.NET comme les Anglets inversion du sujet.

VB.NET déclaration et affectation sur la même ligne
VBA déclaration puis affectation sur une autre ligne.

affectation d'Objet la variable qui ressoi la référence de l'objet précédé de SET!
14/11/2014, 22h58
logaiete

cool,

je regarde ça ,j'avance et vous tiens informé.

un petit détail:

en vba pas d'héritage de polymorphisme n'y de surcharge!
les fonction

Code:

1
2
 sub Name(parmetre1 as type)
end sub

Int Name(){}

Code:

1
2
3
Function Name(parmetre1 as type) as type'Integer,String....
Name="toto" 'pas de return
end function

Pour compléter ce qui à déjà été dit, voici quelques précisions.

Derrière ce qu’on appel macro ce cache un sub (fonction Void).
VBA connait la notion de classe mais pas l’héritage, le polymorphisme, n’y même la surcharge.
Ne parlons pas d’interface au sans .net.

Vba gère les collections les dictionnary mais pas les requêtes sur les objets vba ne dispose pas d’un vocabulaire aussi riche que .net.

Tu trouveras ci dessous trois exemples de la même classe. Soit indulgent sur la partie que tu connais le mieux ; le code n’est pas des plus académique mais ce n’était pas le propos dans mon esprit mais plus de te proposer trois versions strictement identique !

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
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Runtime.InteropServices;
 
namespace WindowsFormsApplication1
{
    public class CreatGetObject
    {
        public dynamic GetObject(String App)
        {
 
            try
            {
                return (dynamic)Marshal.GetActiveObject(App);
            }
            catch
            {
                return (dynamic)CreateObject(App);
            }
 
        }
        public dynamic CreateObject(string app)
        {
            dynamic AppType = Type.GetTypeFromProgID(app);
            dynamic ApplInst = Activator.CreateInstance(AppType);
            return ApplInst;
        }
    }
}

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
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
 
namespace WindowsFormsApplication1
{
    public class WindowsExploreur : CreatGetObject
    {
        //'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
        public Boolean Repertoires_Existe(String Repertoires)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            return Fso.FolderExists(Repertoires);
        }
        //'Taille d'un répertoire
        public Boolean Taille_Repertoire(string Repertoire)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            dynamic Rep = Fso.GetFolder(Repertoire);
            return Rep.Size;
        }
        //'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
        public void Creer_Repertoires(string NewRepertoires)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            string[] t = null;
            string R = null;
            t = NewRepertoires.Split(new Char[] { '\\' });
            for (int I = 0; I < t.Count(); I++)
            {
                if (t[I].Trim() != "")
                {
                    R = R + t[I].Trim() + "\\";
                    if (Repertoires_Existe(R) == false) { Fso.CreateFolder("" + R); }
                }
 
            }
        }
        public void Creer_RepertoiresServeur(string Serveur, string NewRepertoires)
        {
            if (Serveur.PadRight(1) != "\\") { Serveur += "\\"; }
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            string[] t = null;
            string R = null;
            t = NewRepertoires.Split(new Char[] { '\\' });
            for (int I = 0; I < t.Count(); I++)
            {
                if (t[I].Trim() != "")
                {
                    R = R + t[I].Trim() + "\\";
                    if (Repertoires_Existe(Serveur + R) == false) { Fso.CreateFolder(Serveur + R); }
                }
 
            }
        }
        //'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
        public void Copie_Repertoires(string Source, String Destination)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            Fso.CopyFolde(Source, Destination, true);
        }
        //'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
        public void Deplace_Repertoire(String Source, String Destination)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            Fso.MoveFolder(Source, Destination);
        }
        //'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
        public void Supprimer_Repertoire(string DelRepertoire)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            Fso.DeleteFolder(DelRepertoire, true);
        }
        //'Taille d'un répertoire
        public long Taille_Fichier(string Fichier)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            dynamic Fich = Fso.GetFile(Fichier);
            return Fich.Size();
        }
        //'Vérifie lexistance d'un   fichier
        public Boolean Fichier_Exist(string Fichier)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            return Fso.FileExists(Fichier);
        }
        //'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
        public string Fichier_Name(string Fichier)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            if (Fichier_Exist(Fichier) == true) { return Fso.GetBaseName(Fichier); } else { return ""; }
        }
        //'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
        public string Fichier_extension(string Fichier)
        {
            if (Fichier_Exist(Fichier) == true)
            {
                dynamic Fso = CreateObject("Scripting.FileSystemObject");
                return Fso.GetExtensionName(Fichier);
            }
            else
            {
                return "";
            }
        }
        //'Copie un fichier d'une source vers une destination.
        public void Copie_Fichier(string Source, String Destination)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            Fso.CopyFil(Source, Destination, true);
        }
        //'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
        public void Deplace_Fichier(string Source, String Destination)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            Fso.MoveFile(Source, Destination);
        }
        //'Supprime le ou les fichiers dont le nom est précisé en argument.
        public void Supprimer_Fichier(string DelFichier)
        {
            if (Fichier_Exist(DelFichier) == true)
            {
                dynamic Fso = CreateObject("Scripting.FileSystemObject");
                Fso.DeleteFil(DelFichier, true);
            }
        }
        private void AppendTxt(string sFile, string sText)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            dynamic NewFichier = Fso.OpenTextFile(sFile, 8);
            NewFichier.Write(sText);
            NewFichier.Close();
        }
        public void FichierLog(string FichierLog, string txt, String Entete = "")
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            if (Fso.FileExists(FichierLog) == false) { EnteteFichier(FichierLog, Entete); }
            AppendTxt(FichierLog, txt);
        }
        private void EnteteFichier(string Fichier, string txt)
        {
            dynamic Fso = CreateObject("Scripting.FileSystemObject");
            dynamic NewFichier = Fso.OpenTextFile(Fichier, 2, true);
            NewFichier.Write(txt);
            NewFichier.Close();
        }
    }
}

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
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
 
 
Public Class WindowsExporer
    Inherits Env
    Implements IDisposable
    ' Field to handle multiple calls to Dispose gracefully.
    Dim disposed As Boolean = False
 
    ' Implement IDisposable.
    Public Overloads Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
 
    Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
        If disposed = False Then
            If disposing Then
                ' Free other state (managed objects).
                disposed = True
            End If
            ' Free your own state (unmanaged objects).
            ' Set large fields to null.
        End If
    End Sub
 
    Protected Overrides Sub Finalize()
        ' Simply call Dispose(False).
        Dispose(False)
    End Sub
    Public Function AppPath() As String
        Dim p As String
        ' Recupere le chemin complet avec le nom de l'executable
        p = Application.ExecutablePath
        Return p.Substring(0, p.LastIndexOf("\"))
        'End If
    End Function
    'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
    Public Function Repertoires_Existe(ByRef Repertoires As String) As Boolean
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        Repertoires_Existe = fso.FolderExists(Repertoires)
        fso = Nothing
    End Function
    Public Function GetFolders(ByVal Repertoires As String) As Object
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        If Repertoires_Existe(Repertoires) = True Then Return fso.GetFolder(Repertoires)
        fso = Nothing
        Return Nothing
    End Function
 
    'Taille d'un répertoire
    Public Function Taille_Repertoire(ByRef Repertoire)
        Dim fso As Object
        Dim Rep As Object
        fso = CreateObject("Scripting.FileSystemObject")
        Rep = fso.GetFolder(Repertoire)
        Taille_Repertoire = Rep.Size
    End Function
    Function Repertoire_Date_Creation(ByRef Repertoire)
        Dim fso As Object
        Dim Rep As Object
        fso = CreateObject("Scripting.FileSystemObject")
        Rep = fso.GetFolder(Repertoire)
        Repertoire_Date_Creation = Rep.DateCreated
    End Function
    'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
    Public Sub Creer_Repertoires(ByRef NewRepertoires As String)
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        Dim t
        Dim R As String
        Dim I As Long
        On Error Resume Next
        R = ""
        t = Split(NewRepertoires & "\", "\")
        For I = 0 To UBound(t)
            If Trim("" & t(I)) <> "" Then
                R = R & Trim("" & t(I))
                If Repertoires_Existe(R) = 0 Then fso.CreateFolder("" & R)
            End If
            R = R & "\"
        Next
        fso = Nothing
        On Error GoTo 0
    End Sub
    'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
    Public Sub Copie_Repertoires(ByRef Source As String, ByRef Destination As String)
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        fso.CopyFolder(Source, Destination, True)
        fso = Nothing
    End Sub
    'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
    Public Function Deplace_Repertoire(ByRef Source As String, ByRef Destination As String) As String
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        fso.MoveFolder(Source, Destination)
        If Err.Number > 0 Then Deplace_Repertoire = Err.Description
        Err.Clear()
        On Error GoTo 0
        fso = Nothing
    End Function
    'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
    Public Sub Supprimer_Repertoire(ByRef DelRepertoire As String)
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        fso.DeleteFolder(DelRepertoire, True)
        fso = Nothing
    End Sub
    'Taille d'un répertoire
    Public Function Taille_Fichier(ByRef Fichier)
        Dim fso As Object
        Dim Fich As Object
        fso = CreateObject("Scripting.FileSystemObject")
        Fich = fso.GetFile(Fichier)
        Taille_Fichier = Fich.Size
    End Function
    'Vérifie lexistance d'un   fichier
    Public Function Fichier_Exist(ByRef Fichier As String)
        Dim Fso As Object
        Fso = CreateObject("Scripting.FileSystemObject")
        Fichier_Exist = Fso.FileExists(Fichier)
        Fso = Nothing
    End Function
    'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
    Public Function Fichier_Name(ByRef Fichier As String)
        Dim fso As Object
        Fichier_Name = ""
        If Fichier_Exist(Fichier) <> 0 Then
            fso = CreateObject("Scripting.FileSystemObject")
            Fichier_Name = fso.GetBaseName(Fichier)
            fso = Nothing
        End If
    End Function
    'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
    Public Function Fichier_extension(ByRef Fichier As String)
        Dim fso As Object
        If Fichier_Exist(Fichier) <> 0 Then
            fso = CreateObject("Scripting.FileSystemObject")
            Return fso.GetExtensionName(Fichier)
            fso = Nothing
        End If
        Return ""
    End Function
 
    'Copie un fichier d'une source vers une destination.
    Public Sub Copie_Fichier(ByRef Source As String, ByRef Destination As String)
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        fso.CopyFile(Source, Destination, True)
        fso = Nothing
    End Sub
    'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
    Public Sub Deplace_Fichier(ByRef Source As String, ByRef Destination As String)
        Dim fso As Object
        fso = CreateObject("Scripting.FileSystemObject")
        fso.MoveFile(Source, Destination)
        fso = Nothing
    End Sub
    'Supprime le ou les fichiers dont le nom est précisé en argument.
    Public Sub Supprimer_Fichier(ByRef DelFichier As String)
        If Fichier_Exist(DelFichier) <> 0 Then
            Dim fso As Object
            fso = CreateObject("Scripting.FileSystemObject")
            fso.DeleteFile(DelFichier, True)
            fso = Nothing
        End If
    End Sub
    Private Sub AppendTxt(ByRef sFile, ByRef sText)
        Dim fso, NewFichier
        fso = CreateObject("Scripting.FileSystemObject")
        NewFichier = fso.OpenTextFile(sFile, 8)
        NewFichier.Write(sText)
        NewFichier.Close()
        NewFichier = Nothing
        fso = Nothing
    End Sub
    Public Sub FichierLog(ByRef sFile, ByRef txt)
        Dim FichierLog, fso
        FichierLog = sFile
 
        ''CreerPath FichierLog
        fso = CreateObject("Scripting.FileSystemObject")
        If Fichier_Exist(FichierLog) = 0 Then EnteteFichier(FichierLog)
        AppendTxt(FichierLog, txt)
        fso = Nothing
    End Sub
 
    Private Sub EnteteFichier(ByRef Fichier)
        Dim txt, fso, NewFichier
        txt = "***********************************************************************************************************************************************************************************"
        txt = txt & vbCrLf
        txt = txt & ""
        txt = txt & vbCrLf
        txt = txt & "   Date de création: " & DateAndTime.Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Now) & ":" & Minute(Now) & vbCrLf
        txt = txt & vbCrLf
        txt = txt & "   " & Fichier
        txt = txt & vbCrLf
        txt = txt & "***********************************************************************************************************************************************************************************"
        txt = txt & vbCrLf
        txt = txt & vbCrLf
        'txt = ""
        'WScript.Echo Fichier
        fso = CreateObject("Scripting.FileSystemObject")
        NewFichier = fso.OpenTextFile(Fichier, 2, True)
        NewFichier.Write(txt)
        NewFichier.Close()
        NewFichier = Nothing
        fso = Nothing
    End Sub
End Class

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
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = fso.FolderExists(Repertoires)
Set fso = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim fso As Object
Dim Rep As Object
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
  Dim fso As Object
Dim Rep As Object
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Repertoire_Date_Creation = Rep.DateCreated
 
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim t
Dim R As String
Dim I As Long
R = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t)
    If Trim("" & t(I)) <> "" Then
        R = R & Trim("" & t(I)) & "\"
        If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
    End If
Next
Set fso = Nothing
End Sub
 
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Function Deplace_Repertoire(Source As String, Destination As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set fso = Nothing
End Function
 
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Taille d'un répertoire
Public Function Taille_Fichier(Fichier)
Dim fso As Object
Dim Fich As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = fso.FileExists(Fichier)
Set fso = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_Name(Fichier As String)
Dim fso As Object
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = fso.GetBaseName(Fichier)
Set fso = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_extension(Fichier As String)
Dim fso As Object
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = fso.GetExtensionName(Fichier)
Set fso = Nothing
End If
End Function
 
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source, Destination
Set fso = Nothing
End Sub
 
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier As String)
If Fichier_Exist(DelFichier) = True Then
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim fso, NewFichier
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(sFile, 8)
 
NewFichier.Write sText
NewFichier.Close
 
Set NewFichier = Nothing
Set fso = Nothing
 
End Function
 
Public Sub FichierLog(sFile, txt)
Dim FichierLog, fso
 
FichierLog = sFile
 
 
''CreerPath FichierLog
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
 
AppendTxt FichierLog, txt
 
Set fso = Nothing
End Sub
 
Private Sub EnteteFichier(Fichier)
Dim txt, fso, NewFichier
 
txt = "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & ""
txt = txt & vbCrLf
txt = txt & "   Date de création: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
txt = txt & vbCrLf
txt = txt & "   " & Fichier
txt = txt & vbCrLf
txt = txt & "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & vbCrLf
txt = ""
 'WScript.Echo Fichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
 
 
Set NewFichier = Nothing
Set fso = Nothing
End Sub

17/11/2014, 10h28
logaiete

Salut rdurupt,

Merci encore pour ces précisions.
Je continue à avancer et te montrerai le résultat d'ici là.

Salut les amis,

j'ai avancé considérable en programmation de mes UserForms voir capture d'écrans et fichier xlsm dans les posts précédents.

code UserForm figure 4(FixedAssetManagement):

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
Option Explicit
 
Private Sub btnAddNewAsset_Click()
    AddNewItem.Show
End Sub
 
Private Sub btnAddNewCategorie_Click()
    AddNewCategory.Show
End Sub
 
Private Sub btnExit_Click()
    FixedAssetManagement.Hide
End Sub
 
Private Sub btnImportFixedAssetFile_Click()
 
End Sub
 
Private Sub btnUpdateSummary_Click()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub

code UserForm figure 5(AddNewCategory):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
 
Private Sub UserForm_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
'Se positionner à la feuille personnel
    'Sheets("fichier-type_avoir").Select
    Sheets("lifetime").Select
'Récupération de valeur de la colonne lifetime
'ActiveWorkbook.Names.Item("lifetime").RefersTo = [Listes!B3:B10]
'Dim i As Integer
'For i = 1 To 4 ' => pour lister les 4 pays
       'ComboBoxLifeTime.AddItem Cells(1, i) 'Ajoute les valeurs des cellules B3 à B10 avec la boucle
       'ComboBoxLifeTime.AddItem Range("bi").Select
       ComboBoxLifeTime.AddItem "3"
       ComboBoxLifeTime.AddItem "4"
       ComboBoxLifeTime.AddItem "5"
       ComboBoxLifeTime.AddItem "10"
 
   'Next
End Sub

code userForm figure 6(AddNewItem):

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
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
67
68
69
70
71
72
73
74
75
76
Option Explicit
 
Private Sub btnCancel_Click()
AddNewItem.Hide
End Sub
 
Private Sub UserForm_Click()
 
End Sub
Private Sub UserForm_Initialize()
    'Remplissage de la combo asset type
    'ComboBoxAssetType.AddItem "building"
    'ComboBoxAssetType.AddItem "Leasohold improvement"
    'ComboBoxAssetType.AddItem "Machinery"
    'ComboBoxAssetType.AddItem "IT Hardware"
    'ComboBoxAssetType.AddItem "IT Software"
    'ComboBoxAssetType.AddItem "Vehicules"
    'ComboBoxAssetType.AddItem "Furniture/Fixtures"
    'ComboBoxAssetType.AddItem "Iptable"
 
    'Se positionner à la feuille fichier-type_avoir
    Sheets("fichier-type_avoir").Select
    Dim numero As Integer
    numero = 3 'Numéro de départ (correspond ici au n° de ligne et au n° de numérotation)
 
    While numero <= 10 'TANT QUE la variable numero est <= 12, la boucle est répétée
       'Cells(numero, 1) = numero 'Numérotation
       ComboBoxAssetType.AddItem Cells(numero, 1)
       numero = numero + 1 'Le numéro est augmenté de 1 à chaque boucle
    Wend
 
    fillComboMonth
    fillComboDay
    fillComboYear
 
 
End Sub
 
Sub fillComboMonth()
    'MsgBox "ok !!!"
 
    'Remplissage de la combo ComboBoxMonth
    Dim numMonth As Integer
    numMonth = 1 'mois de départ
    While numMonth <= 12 'TANT QUE la variable numMonth est <= 12, la boucle est répétée
       ComboBoxMonth.AddItem numMonth
       numMonth = numMonth + 1 'Le numMonth du mois est augmenté de 1 à chaque boucle
    Wend
    'ComboBoxMonth.ListIndex = 0
End Sub
 
Sub fillComboDay()
    'Remplissage de la combo ComboBoxDay
    Dim numDay As Integer
    numDay = 1 'Jour de  de départ
 
    While numDay <= 31 'TANT QUE la variable numDay est <= 31, la boucle est répétée
       ComboBoxDay.AddItem numDay
       numDay = numDay + 1 'Le numDay est augmenté de 1 à chaque boucle
    Wend
End Sub
 
Sub fillComboYear()
    'Remplissage de la combo ComboBoxDay
    Dim numYear As Integer
    numYear = 2014 'Année de départ
 
    While numYear <= 2020 'TANT QUE la variable numYear est <= 2020, la boucle est répétée
       'Cells(numero, 1) = numero 'Numérotation
       ComboBoxYear.AddItem numYear
       numYear = numYear + 1 'Le numéro est augmenté de 1 à chaque boucle
    Wend
End Sub
Sub avertissement(texte As String)
    MsgBox "Attention : " & texte & " !"
End Sub

Mes petites questions :
1 Je veux insérer une nouvelle ligne dans la feuille (fichier-type_avoir) lors du click sur le bouton Ok de ma figure 5 ()en récupérant les valeurs renseignés dans mon UseForm)

2- Je veux insérer une nouvelle ligne dans la feuille (fichier-actifs immobilisés) lors du click du bouton OK de ma figure 6() en y ajoutant en ID unique dans le champ ID et en récupérant les valeurs renseignées

3- Lors du click du bouton Import fixed asset file,j'importe un nouveau fichier-actifs fixes (format .csv). Le contenu précédent du fichier des immobilisations càd la feuille (fichier-actifs immobilisés) est retiré

3- Je veux mettre à jour le feuille (fichier-resume-immobilisation) lors du click du bouton Update Summary (voir figure 4) en fonction de la valeurs de deux précédentes feuilles.

Merci d'avance

Bonjour,
1)

Code:

1
2
3
4
5
Private Sub Ok_Click()
Dim DerL As Long
DerL = Sheets("fichier-type_avoir").Cells(Sheets("fichier-type_avoir").Cells.Rows.Count, 1).End(xlUp).Row + 1
Sheets("fichier-type_avoir").Cells(DerL, 1).Value = Me.textbox1.Text
End Sub

2) en ce qui concerne une clé primaire, je te suggère un onglet config.

Code:

1
2
3
4
5
6
7
8
9
Private Sub Ok_Click()
Dim Id As Long
Dim DerL As Long
Id = Sheets("Config").Range("B1").Value + 1
Sheets("Config").Range("B1").Value = Id
DerL = Sheets("fichier-actifs immobilisés").Cells(1, Sheets("fichier-actifs immobilisés").Cells.Rows.Count).End(xlUp).Row + 1
Sheets("fichier-actifs immobilisés").Cells(DerL, 1).Value = Id 'cells("A" & DerL)
Sheets("fichier-actifs immobilisés").Cells(DerL, 2).Value = Me.textbox1.Text  'cells("B" & DerL)
End Sub

Code:

Sheets("fichier-actifs fixes").UsedRange.ClearContents

20/11/2014, 15h32
logaiete

Salut rdupt,
merci pour ta réponse.
Néanmoins,j'aimerais que tu me connecte le code ce qu'il fait.

Dans la question 1

Les champs que je veux recupérer lors de la saisie sont :

un objet textbox nommé TextBox1
un objet Combobox nommé comboLifetime (combobox)qui est une valeur que l'utilisateur entière (3,4,5,10) que l'utilisateur doit sélectionner
un objet checkbox nommé chkbox1 true par défaut et chkbox2 grisé

Et je veux que lors du click ces valeurs soit respectivement insérer à la ligne 3 toujours dans la feuille fichier-type_avoir

comment récupérer ces valeurs et toujours insérer à la ligne 3

merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Ok_Click()
Sheets("fichier-type_avoir").Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
If Me.CheckBox1.Value = True Then Sheets("fichier-type_avoir").Cells(3, 2) = 1 Else Sheets("fichier-type_avoir").Cells(3, 2) = 0
End Sub
 
Private Sub UserForm_Initialize()
'Me.comboLifetime.List = Sheets("Congig").Range("D2: D20")
'OU
'For i = 1 To 10
'    Me.comboLifetime.AddItem i
'    If comboLifetime.List(comboLifetime.ListCount) = Sheets("fichier-type_avoir").Cells(3, 1) Then Me.comboLifetime.ListIndex = i
'Next
'Dim R As Range
'Set R = Sheets("Congig").Range("D2: D20")
'For i = 1 To R.Rows.Count
'    Me.comboLifetime.AddItem i
'    If R(i, 1) = Sheets("fichier-type_avoir").Cells(3, 1) Then Me.comboLifetime.ListIndex = i
'Next
Me.CheckBox1.Value = Sheets("fichier-type_avoir").Cells(3, 2)
Me.CheckBox2.Value = Sheets("fichier-type_avoir").Cells(3, 3)
 
End Sub

Salut rdurupt,

J'ai avancé avec mon application.

J'ai inséré un bouton application qui déclenche le Userform d'inittialisation de mes useform.

Quand je click sur add a new category,il m'ouvre le useform correspondant mais je n'arrive pas à ajouter une nouvelle ligne.il bloque et ne me permet pas
de taper les valeurs.

code UserForm AddNewCategory

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
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
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Private Sub btnCancel_Click()
    AddNewCategory.Hide
End Sub
 
Private Sub btnOK_Click()
'Dim DerL As Long
'DerL = Sheets("fichier-type_avoir").Cells(Sheets("fichier-type_avoir").Cells.Rows.Count, 1).End(xlUp).Row + 1
'Sheets("fichier-type_avoir").Cells(DerL, 1).Value = Me.TextBox1.Text
    If Len(TextBox1) = 0 Then
        MsgBox "Vous devez obligatoirement saisir une valeur"
        Else
    'Se positionner à la feuille fiche-type_avoir
    Sheets("fiche-type_avoir").Select
    'Selectionne la ligne numero 3 (car toute nouvelle insertion se fera à la ligne 3)
    Rows("3:3").Select
    'insertion d'une ligne en descendant tout le reste en dessous
    Selection.Insert shift:=xlDown
    'Venir sur la cellule A3
    Range("a3").Select
    'insertion de la valeur du name
    ActiveCell.Formula = AddNewCategory.TextBox1
    'Venir sur la cellule B3
    Range("b3").Select
    'insertion de la valeur de lifetime recuperer dans la combo
    ActiveCell.Formula = CInt(AddNewCategory.ComboBoxLifeTime.Value)
    'Venir sur la cellule C3
    Range("C3").Select
    'insertion de la valeur de StraightLine recuperer dans la checkbox
    If AddNewCategory.btnRadioStraightLine = True Then
        ActiveCell.Formula = "StraightLine"
    End If
    'Après insertion je ferme le UserForm
    AddNewCategory.Hide
 
 
 
End Sub
 
Private Sub TextBox1_AfterUpdate()
    'test de la presence de caractère dans le champ nom
If Len(TextBox1) = 0 Then
    MsgBox "Vous devez saisir un nom"
Else
    'Supprime les espaces devant et derrière
    TextBox1 = Trim(TextBox1)
    'Mettre en majuscule le premier caractère et en miniscule le reste
    TextBox1 = UCase(Left(TextBox1, 1)) & LCase(Right(TextBox1, Len(TextBox1) - 1))
End If
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
'Se positionner à la feuille personnel
    'Sheets("fichier-type_avoir").Select
    'Sheets("lifetime").Select
'Récupération de valeur de la colonne lifetime
'ActiveWorkbook.Names.Item("lifetime").RefersTo = [Listes!B3:B10]
'Dim i As Integer
'For i = 1 To 4 ' => pour lister les 4 pays
       'ComboBoxLifeTime.AddItem Cells(1, i) 'Ajoute les valeurs des cellules B3 à B10 avec la boucle
       'ComboBoxLifeTime.AddItem Range("bi").Select
       ComboBoxLifeTime.AddItem "3"
       ComboBoxLifeTime.AddItem "4"
       ComboBoxLifeTime.AddItem "5"
       ComboBoxLifeTime.AddItem "10"
 
   'Next
End Sub

Je ne vois pas l'erreur,il ne l'indique pas et je ne peux pas inserer une valeur sur la feuille fichier-type_avoir.
Apparemment il n'y a pas d'erreur.Pouvez me dire qu'est ce qui ne va pas ????

En pièces jointes mon classeur excel et les captures d'écran

Bonjour,
autant que faire ce peut n'utilise pas de select, selection et autre activate décline l’arborescence de l'objet!
quand tu es dans le UserForm ne le nomme pas par sont nom mais par Me.
ne fais pas des if then else inutile qui complique la lisibilité du code surtout si le but est de rien faire (sortir du sub)
réserve le mot Formula pour intégrer des formule dans ton tableau EXCEL!

n'oublis pas que l' Hide ne ferme pas le userform mais le masque à charge à la macro appelante de le faire Unload FRM
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub btnOK_Click() 'Si condition pas Ok je quite la SUB If Len(TextBox1) = 0 Then MsgBox "Vous devez obligatoirement saisir une valeur": Exit Sub 'on utilise pas de select selection activate 'nous sommes dans une collection de classe on décline With Sheets("fiche-type_avoir") .Rows("3:3").Insert shift:=xlDown .Range("a3").Value = Me.TextBox1 .Range("b3").Value = CInt(Me.ComboBoxLifeTime.Value) If Me.btnRadioStraightLine = True Then .Range("C3").Value = "StraightLine" End If End With Me.Hide End Sub

Salut rdurupt,

merci,j'ai remplacé le code par

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
 
Private Sub btnCancel_Click()
    AddNewCategory.Hide
End Sub
Private Sub btnOK_Click()
'Si condition pas Ok je quite la SUB
If Len(TextBox1) = 0 Then MsgBox "Vous devez obligatoirement saisir une valeur": Exit Sub
'on utilise pas de select selection activate
'nous sommes dans une collection de classe on décline
    With Sheets("fiche-type_avoir")
        .Rows("3:3").Insert shift:=xlDown
        .Range("a3").Value = Me.TextBox1
        .Range("b3").Value = CInt(Me.ComboBoxLifeTime.Value)
        If Me.btnRadioStraightLine = True Then
         .Range("C3").Value = "StraightLine"
    End If
    End With
    Me.Hide
 
End Sub
 
Private Sub TextBox1_AfterUpdate()
    'test de la presence de caractère dans le champ nom
If Len(TextBox1) = 0 Then
    MsgBox "Vous devez saisir un nom"
Else
    'Supprime les espaces devant et derrière
    TextBox1 = Trim(TextBox1)
    'Mettre en majuscule le premier caractère et en miniscule le reste
    TextBox1 = UCase(Left(TextBox1, 1)) & LCase(Right(TextBox1, Len(TextBox1) - 1))
End If
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
'Se positionner à la feuille personnel
    'Sheets("fichier-type_avoir").Select
    'Sheets("lifetime").Select
'Récupération de valeur de la colonne lifetime
'ActiveWorkbook.Names.Item("lifetime").RefersTo = [Listes!B3:B10]
'Dim i As Integer
'For i = 1 To 4 ' => pour lister les 4 pays
       'ComboBoxLifeTime.AddItem Cells(1, i) 'Ajoute les valeurs des cellules B3 à B10 avec la boucle
       'ComboBoxLifeTime.AddItem Range("bi").Select
       ComboBoxLifeTime.AddItem "3"
       ComboBoxLifeTime.AddItem "4"
       ComboBoxLifeTime.AddItem "5"
       ComboBoxLifeTime.AddItem "10"
 
   'Next
End Sub

Je n'arrive pas toujours à insérer,je n'arrive même pas à taper quoique ce soit ça bloque.Je suis obligé de quitter même l'application excel

Peux tu avec le fichier que je t'ai envoyé tester l'insertion d'un nouvelle ligne pour le userForm Add New Category

Merci encore.

21/11/2014, 13h21
Invité

1 pièce(s) jointe(s)

tu as placé ton UserForm à Enabled=false ça interdit toute intervention dessus!

pour revenir à ton code si ça ce reproduit: raccourci clavier [CTRL] + [Pause]

Salut rdurupt,

Effectivement il était à Enable False,je l'ai mis à true et quand je vais insérer,il me donne cette erreur.

Je vais faire toute insertion à la ligne 3

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub btnOK_Click()
'Dim DerL As Long
'DerL = Sheets("fichier-type_avoir").Cells(Sheets("fichier-type_avoir").Cells.Rows.Count, 1).End(xlUp).Row + 1
'Sheets("fichier-type_avoir").Cells(DerL, 1).Value = Me.TextBox1.Text
    'If Len(TextBox1) = 0 Then
       ' MsgBox "Vous devez obligatoirement saisir un nom"
       ' Else
        'AddNewCategory.Hide
   'End If
    'Si condition pas Ok je quite la SUB
If Len(TextBox1) = 0 Then MsgBox "Vous devez obligatoirement saisir une valeur": Exit Sub
'on utilise pas de select selection activate
'nous sommes dans une collection de classe on décline
    With Sheets("fiche-type_avoir")
        .Rows("3:3").Insert shift:=xlDown
        .Range("a3").Value = Me.TextBox1
        .Range("b3").Value = CInt(Me.ComboBoxLifeTime.Value)
        If Me.btnRadioStraightLine = True Then
         .Range("C3").Value = "StraightLine"
    End If
    End With
    Me.Hide
End Sub

il me donne ces erreurs voir capture d'écran:

21/11/2014, 13h51
Invité

Désolé je ne sais pas écrire fichier-type_avoir (fichie-type_avoir)

dans mon test j'ai recréé le classeur et le UserForm les fautes ont suivis!
21/11/2014, 19h26
logaiete

Merci rdurupt,

C'était une erreur banale que je n'ai pas vu.
ça marche correctement.
Je joins le fichier GestImm.xlsm ça pourra aider quelqu'un du forum pour traiter ces aspects.
Je vais marquer la discussion à résolu.
21/11/2014, 20h41
Invité
j'espère t'avoir insufflé le minimum requis pour continuer ta route en solitaire!

s'aches que tu trouveras toujours une âme sœur pour t'épauler sur ce forum.
Code:

1 2 3 4 'Après insertion je ferme le UserForm ' AddNewCategory.Hide Unload Me End Sub
21/11/2014, 23h04
logaiete

cool rdurupt,

Au prochain épisode pour la suite.