Recuperer le contenu d'une zone de texte dans une variable

Version imprimable

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

Bonsoir,
j'ai préparé un petit fichier exemple mais depuis que j'ai téléchargé explorer 8, je n'arrive plus à envoyer de fichier, alors je te mets le code, lequel j'espère, tu comprendras, je l'ai essayé, pour continuer à avancer, quand tu te seras rendu compte que ça fonctionne, n'hesites pas à reposter
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub btn_ok_Click() Dim C As Range, dl As Integer With Sheets("documentecriture").Range("a1:a65536") Set C = .Find(txtboxJournal) 'un exemple If Not C Is Nothing Then dl = Sheets("feuil2").Range("a" & Rows.Count).End(xlUp).Row + 1 Sheets("feuil2").Cells(dl, 1).EntireRow.Value = Sheets("documentecriture").Cells(C.Row, 1).EntireRow.Value Sheets("feuil2").Activate End If End With End Sub
enfin, je viens de regler mes problemes pour envoyer le fichier
bonne soirée

13/05/2009, 09h06
lilp1
Salut merci, de ton aide, je voit que ton fichier fonctionne, mais je ne comprend pas les lignes:
Code:

1 2 3 dl = Sheets("feuil2").Range("a" & Rows.Count).End(xlUp).Row + 1 Sheets("feuil2").Cells(dl, 1).EntireRow.Value = Sheets("documentecriture").Cells(C.Row, 1).EntireRow.Value Sheets("feuil2").Activate
Je voit que sa copie la ligne dont la valeur rechercher est présente et que sa colle le résultat a la suite du fichier. Mais je n'arrive pas a cerner l'endroit ou l'on dit de coller le résultat, et je ne voit pas non plus l'endroit ou l'on choisit de coller le résultat
13/05/2009, 09h48
casefayere

Bonjour lilp1, le forum
cette ligne attribue le numéro de la derniere cellule écrite en col A + 1
donc la premiere cellule vide, à dl (une variable integer)

Code:

dl = Sheets("feuil2").Range("a" & Rows.Count).End(xlUp).Row + 1

celle-ci indique se place sur cells(dl,1) en feuille 2 donc sur la premiere cellule vide en col 1, on pourrait remplacer par range("a" & dl), on dit que la ligne entiere est égale à la ligne où se trouve ta reference sur ta feuille "documentecriture" avec cells (c.row,1) qui pourrait sécrire range("a" & c.row)

Code:

Sheets("feuil2").Cells(dl, 1).EntireRow.Value = Sheets("documentecriture").Cells(C.Row, 1).EntireRow.Value

pour la derniere ligne

Code:

Sheets("feuil2").Activate

c'est uniquement pour se placer sur la feuil2 mais ça tu n'est pas obligé

Bonne journée

J'ai réussit a faire sa :

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
Sub Macro1()
Dim rc As Range, rg As Range, firstaddress As String, irow As Integer
'Sélection des lignes à copier. Ici, recherche des journaux = "RB" dans la colonne B
 
    Columns("B:B").Select
    Set rc = Selection.Find(What:="RB", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
           :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
           False)
 
    If Not rc Is Nothing Then
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
       firstaddress = rc.Address
    End If
    irow = 1
    'Screenupdating = false, empêche de voir ce qu'il se passe pendant l'exécution de la macro.
    Application.ScreenUpdating = False
    Do While Not rc Is Nothing
      rc.Activate
      'Sélection de la ligne entière
      rc.EntireRow.Select
      Selection.Copy
      Sheets("Feuil1").Select
      'On se positionne sur le ligne en-dessous de la dernière ligne copiée
      'en incrémentant un compteur irow initialisé à 1 au départ.
      Cells(irow, 1).Select
      irow = irow + 1
      Selection.Insert Shift:=xlDown
      Application.CutCopyMode = False
      Sheets("Ecritures").Select
      rc.Activate
      Set rc = Cells.FindNext(rc)
      If rc Is Nothing Then
        Exit Do
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit Do
      End If
    Loop
    Application.CutCopyMode = False
    Sheets("Ecritures").Select
    Application.Goto reference:=Range("A1"), scroll:=True
    Application.ScreenUpdating = False
End Sub

Mais simplement, cela marche avec une valeur fixe qui est dans l'exemple 'RB', chose que je ne veut pas, mais lorsque je remplace 'RB', par txtboxJournal, cela ne marche plus :s

En attendant que j'analyse ton code, car je suis aussi ailleurs, un petit conseil evites les select,

Code:

1
2
3
4
Columns("B:B").Select
Set rc = Selection.Find(What:="RB", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)

peut se traduire par

Code:

1
2
3
Set rc = Columns("B:B").Find(What:="RB", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)

à +

Oki merci, il me reste une erreur
erreur d'execution '9':
L'indice n'appartient pas a la selection
pour la partie du code
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 irow = 1 Application.ScreenUpdating = False Do While Not rc Is Nothing rc.Activate rc.EntireRow.Select Selection.Copy Sheets("Feuil1").Select Cells(irow, 1).Select irow = irow + 1 Selection.Insert Shift:=x1Down Application.CutCopyMode = False Sheets("Documentecriture").Select rc.Activate
C'est la ligne en rouge qui a un probleme

13/05/2009, 10h23
casefayere

C'est normal, tu n'as pas de feuil1 mais "ecritures", d'ailleurs j'ai l'impression que les noms de tes feuilles ont changé entre temps
attention, grosse erreur en fin de programme

Code:

Application.ScreenUpdating = true

je suis en train de regarder ton code mais le trouve bien compliqué pour le résultat escompté
13/05/2009, 10h36
lilp1

Merci. Sa marche maintenant, il ne me reste plus qu'a réussit a copier les résultats dans une nouvelle feuille et de le faire pour ne valeur non prédéfinie

SAurrait-tu comment selectionner la derniere feuille créer du classeur, car lorsque j'ajoute une feuille, elle va s'appeler 'feuil1', mais si j'en ajoute plusieurs, elles vont s'appeler progressivement feuil2 puis 3..... or dans mon code, je doit fixer un nom de feuille sur lequel se positioner.
13/05/2009, 11h22
casefayere
essaie déjà ce code qui donne le nom de la derniere feuille
Code:

1 2 3 4 Sub Macro1() MsgBox Sheets(Sheets.Count).Name End Sub
ensuite tu pourras la renommer

je suis obligé de partir, je suivrai un peu plus tard
a +
13/05/2009, 11h49
lilp1

Merci beaucoup pour ton aide, j'ai réussit à faire ce que je voulais.
13/05/2009, 13h58
lilp1

J'aurrait encore besoin d'aide lol.
Dans Excel, la personne avant moi avait rajouter un onlget qui est venut s'ajouter à coter du point d'intérrogation pour l'aide et dans cette onglet, j'ai rajouter un menu 'selectionner un journal' j'aimerais que lorsque je click sur ce menu, cela m'ouvre mon userform. Mais quand je click dessus pour le moment, il me dit "Impossible de trouver la maccro "Excel_To_PGI_VO.xls!selection_Journal"
Serait-tu comment résoudre ce problemes?
13/05/2009, 14h02
casefayere

là, je ne connais pas trop cette façon de faire mais ton message

Citation:

"Impossible de trouver la maccro "Excel_To_PGI_VO.xls!selection_Journal"

cette macro existe-t'elle dans ton programme, recherches là

a +
13/05/2009, 14h06
lilp1

NOn justement, mais le probleme, c'est que je ne connait pas les maccros :s
13/05/2009, 14h09
casefayere

Regardes bien

Citation:

"Impossible de trouver la maccro "Excel_To_PGI_VO.xls!selection_Journal"

déjà, je parie que ton classeur n'a pas ce nom Excel_To_PGI_VO.xls
maintenant il faudrait savoir ce que contient cette macro selection_Journal enregistrée ailleurs
pour l'adapter à ton programme
ou bien il faut en refaire une

Comme le problème est différent, je te proposerais bien d'ouvrir une nouvelle discussion basée sur ce problème spécifique

Citation:

Dans Excel, la personne avant moi avait ajouté un onglet qui est venu s'ajouter à coté du point d'interrogation pour l'aide et dans cette onglet, j'ai rajouté un menu 'selectionner un journal' j'aimerais que lorsque je click sur ce menu, cela m'ouvre mon userform.
13/05/2009, 16h48
lilp1

Désolé de revenir a la charge, mais je viens de m'apercevoir apres avori effectuer quelques tests, que a rechercher ne s'effectuait pas sur une seule colonne malgré le fait que dans le code au niveau de la rechercher je spécifie:

Code:

Set rc = Columns("A:A").Find(txtboxJournal,

Je ne voudrais pas me méler de ce qui ne me regarde pas mais pourquoi n'as-tu pas gardé le code simple que j'avais proposé
Code:

1 2 3 4 5 6 7 8 9 10 With sheets("Documentecriture")'gaffe au nom de la feuille dl = .range("a" & rows.count).end(xlup).row Set C = .Range("a2:a" & dl).Find(txtboxJournal) 'un exemple if not C is nothing then der = sheets("feuil2").range("a" & rows.count).end(xlup).row 'variable à déclarer sheets("feuil2").cells(der,1).entirerow = sheets("documentecriture").cells(c.row,1).entirerow end if End With
si plusieurs éléments correspondent à txtboxJournal, il suffit d'ajouter une boucle

13/05/2009, 17h15
lilp1

Tout simplement car je n'avais pas réussit a le faire fonctionner dans mon cas, dsl
13/05/2009, 17h21
casefayere

Comme je ne sais pas pour quelle raison (qui doit etre reelle), je te dis quand meme que la version du code ci-dessus, je l'ai un peu aménagée,

si tu pouvais envoyer un extrait de fichier, ça ne serait pas plus mal

Bonne fin de journée

Voici tout le code, aussi bien de la recherche, que de la crétation de la nouvelle feuille, son changement de nom, et le copier/coller des valeurs recherchées dans la nouvelle feuille créée.

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
Private Sub btn_ok_Click()
Dim rc As Range, rg As Range, firstaddress As String, irow As Integer, nomfeuille As String 'declaration des variables
'rechercher dans la colonne 'A' les valeurs de la TextBox
    Set rc = Range("A:A").Find(txtboxJournal, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
           :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
           False)
'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = txtboxJournal
nomfeuille = ActiveSheet.Name
'selection de la feuille d'information
Sheets("Documentecriture").Select
If Not rc Is Nothing Then
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
       firstaddress = rc.Address
    End If
    irow = 1
    Application.ScreenUpdating = False
    Do While Not rc Is Nothing
      rc.Activate
      'Sélection de la ligne entière
      rc.EntireRow.Select
      Selection.Copy
      'selection de la nouvelle feuille pour enregistrer les résultat dedans
      Sheets(nomfeuille).Select
      'On se positionne sur le ligne en-dessous de la dernière ligne copiée
      'en incrémentant un compteur irow initialisé à 1 au départ.
      Cells(irow, 1).Select
      irow = irow + 1
      Selection.Insert Shift:=xlDown
      Application.CutCopyMode = False
      'reselection de la feuille d'information pour la suite du parcours
      Sheets("Documentecriture").Select
      rc.Activate
      Set rc = Cells.FindNext(rc)
      If rc Is Nothing Then
        Exit Do
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit Do
      End If
    Loop
    Application.CutCopyMode = False
    Sheets("Documentecriture").Select
    Application.Goto reference:=Range("A1"), Scroll:=True
    MsgBox ("Le Journal a bien été copié")
End Sub

Le probleme de ton code vient surement de moi qui doit avoir du mal a l'adapter a mon cas.
En tout cas, je te remercie encore de ta patience.
Bonne fin de journée a toi aussi. TU a bien de la chance de finir a cette heure la, il me reste encore 30mns :s lol

re,
je crois avoir trouvé, sauvegardes ton fichier et ensuite essayes ce code un peu différent, si ça ne te plait pas, tu pourras quitter sans enregistrer

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
Private Sub btn_ok_Click()
Dim rc As Range, rg As Range, firstaddress As String, irow As Integer, nomfeuille As String, _
dl As Integer, x As Integer 'declaration des variables
'rechercher dans la colonne 'A' les valeurs de la TextBox
With Sheets("Documentecriture")
dl = .Range("a" & Rows.Count).End(xlUp).Row
Set rc = .Range("A2:A" & dl).Find(txtboxJournal)
Application.ScreenUpdating = False
If rc Is Nothing Then MsgBox "pas de correspondance": Exit Sub
If Not rc Is Nothing Then
'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = txtboxJournal
nomfeuille = ActiveSheet.Name
'selection de la feuille d'information
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
       firstaddress = rc.Address
    irow = 1
For x = 2 To dl
      irow = irow + 1
      Sheets(nomfeuille).Cells(irow, 1).EntireRow.Value = rc.EntireRow.Value
      'reselection de la feuille d'information pour la suite du parcours
      Set rc = .Range("A" & rc.Row + 1, "A" & dl).Find(txtboxJournal)
      If rc Is Nothing Then
        Exit For
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit For
      End If
 Next x
.Activate
MsgBox ("Le Journal a bien été copié")
End If
End With
Application.ScreenUpdating = True
End Sub

de toute façon, meme si tu n'adoptes pas mon code, il faut que tu remontes la ligne

Code:

If rc Is Nothing Then MsgBox "pas de correspondance": Exit Sub

sinon ta nouvelle feuille sera toujours créée

ps : j'ai oublié de demander si plusieurs valeurs dans la col A peuvent correspondre à ce que tu rentres dans txtboxJournal ?
si oui, ces valeurs doivent t'elles etre ajoutées à la meme feuille ?
j'imagine que oui car sinon tu auras une erreur (meme nom pour 2 feuilles)

et si oui, copies plutot ce code et non celui du dessus

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
Private Sub btn_ok_Click()
Dim rc As Range, nomfeuille As String, dl As Integer, x As Integer, y As Integer 'declaration des variables
'rechercher dans la colonne 'A' les valeurs de la TextBox
With Sheets("Documentecriture")
dl = .Range("a" & Rows.Count).End(xlUp).Row
Set rc = .Range("A2:A" & dl).Find(txtboxJournal)
Application.ScreenUpdating = False
If rc Is Nothing Then MsgBox "pas de correspondance": Exit Sub
    'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = txtboxJournal
    nomfeuille = ActiveSheet.Name
    y = 2
    Sheets(nomfeuille).Cells(y, 1).EntireRow.Value = rc.EntireRow.Value
    For x = 3 To dl
        Set rc = .Range("A" & rc.Row + 1, "A" & dl).Find(txtboxJournal)
        If Not rc Is Nothing Then
            y = y + 1
            Sheets(nomfeuille).Cells(y, 1).EntireRow.Value = rc.EntireRow.Value
        End If
        If rc.Row = dl Then Exit For
    Next x
.Activate
MsgBox ("Le Journal a bien été copié")
End With
Application.ScreenUpdating = True
End Sub

Peut-être à ce soir ou demain

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