Programmer avec vba et excel 2007

Version imprimable

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

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.

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