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

**casefayere** · 12/05/2009, 21h22

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 :

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

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

**lilp1** · 13/05/2009, 09h06

Salut merci, de ton aide, je voit que ton fichier fonctionne, mais je ne comprend pas les lignes:

Code :

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

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

**casefayere** · 13/05/2009, 09h48

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 :

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

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 :

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

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

pour la derniere ligne

Code :

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

Sheets("feuil2").Activate

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

Bonne journée

**lilp1** · 13/05/2009, 10h03

J'ai réussit a faire sa :

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
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

**casefayere** · 13/05/2009, 10h08

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

Code :

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

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 :

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

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

à +

**lilp1** · 13/05/2009, 10h14

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 vba :

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

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

**casefayere** · 13/05/2009, 10h23

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 :

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

Application.ScreenUpdating = true

je suis en train de regarder ton code mais le trouve bien compliqué pour le résultat escompté

**lilp1** · 13/05/2009, 10h36

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.

**casefayere** · 13/05/2009, 11h22

essaie déjà ce code qui donne le nom de la derniere feuille

Code :

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

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 +

**lilp1** · 13/05/2009, 11h49

Merci beaucoup pour ton aide, j'ai réussit à faire ce que je voulais.

**lilp1** · 13/05/2009, 13h58

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?

**casefayere** · 13/05/2009, 14h02

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

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

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

a +

**lilp1** · 13/05/2009, 14h06

NOn justement, mais le probleme, c'est que je ne connait pas les maccros :s

**casefayere** · 13/05/2009, 14h09

Regardes bien

"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

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.

**lilp1** · 13/05/2009, 16h48

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 :

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

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

**casefayere** · 13/05/2009, 17h03

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 :

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

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

**lilp1** · 13/05/2009, 17h15

Tout simplement car je n'avais pas réussit a le faire fonctionner dans mon cas, dsl

**casefayere** · 13/05/2009, 17h21

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

**lilp1** · 13/05/2009, 17h25

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 vb
:

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
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

**casefayere** · 13/05/2009, 19h11

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 :

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
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 :

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

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 :

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
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

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

Macros et VBA Excel

Discussions similaires

Partager

Partager