VBA code rechercher cellule depuis une ligne listbox

Bonjour à tous,

Mon titre est certainement mal tourné, excusez moi, je suis débutant :-( .

Voici mon problème:

J’ai une listbox dans un UF avec 10 colonnes

Avec un double clic, j’ouvre un Word dans lequel j’ai 36 signets…

Le code que j’utilise pour récupérer mes infos dans le module VBA est par exemple :

.ActiveDocument.Bookmarks("Nom").Range.Text = objList.List(objList.ListIndex, 2)

Quel code pour aller chercher les autres cellules svp?

Toutes mes cellules recherchées sont sur la même feuille Excel qui s'appelle "Table 0"

Merci d'avance

Bonjour FabWeb,

Ce n'est pas le titre qui est mal tourné, c'est la suite du message...

Déjà,

Voici mon problème:

Ce serait plus positif d'écrire

Je cherche une solution:

Je suppose qu'une des colonnes (la 3ième apparemment) de la listbox est alimentée par les 36 signets qui proviennent de la feuille Table 0

Donc en cliquant sur une des lignes de la listbox le signet souhaité est bien récupéré.

Quel code pour aller chercher les autres cellules svp?

Là, il faut préciser, quelles autres cellules sont cherchées...

Il serait plus simple de présenter le code concernant la listBox en intégralité.

Si je laisse, comme un code, un signet, exemple:

page10

Cela ne te donnera pas la signification de l'ensemble de la page.

Merci pour la réponse X Cellus,

Effectivement je recherche la solution :-)

Mes signets sont pour la plupart sur la même ligne, d'autres sont le résultat de formules que j'ai mis après mon tableau à droite

Voici le code dans le UF concernant la Listbox :

Public Sub Prestations(col, czi)
    Dim cel As Range, plg As Range
        ListBox1.Clear
            If czi <> "" Then
                 Set plg = Cells(2, col).Resize(ActiveSheet.Cells(Rows.Count, col).End(xlUp).Row, 1)
                 For Each cel In plg.Cells
            If InStr(LCase(cel.Value), LCase(czi)) > 0 Then Call affiche(cel.Row)
        Next cel
        End If
       End Sub

Public Sub affiche(lig)
            ListBox1.AddItem Format(Cells(lig, "D").Value, "dd/mm/yyyy")
            ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(lig, "F").Value
            ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(lig, "AW").Value
            ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(lig, "AX").Value
            ListBox1.List(ListBox1.ListCount - 1, 4) = Cells(lig, "AZ").Value
            ListBox1.List(ListBox1.ListCount - 1, 5) = Cells(lig, "AA").Value
            ListBox1.List(ListBox1.ListCount - 1, 6) = Cells(lig, "AC").Value
            ListBox1.List(ListBox1.ListCount - 1, 7) = Cells(lig, "AE").Value
            ListBox1.List(ListBox1.ListCount - 1, 8) = Cells(lig, "AG").Value
            ListBox1.List(ListBox1.ListCount - 1, 9) = Cells(lig, "AI").Value
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If MsgBox("Vous allez éditer la ligne " & Me.ListBox1.ListIndex + 1, vbYesNo, "Demande de confirmation") = vbYes Then
  CreationRecap_et_Facture Me.ListBox1
  End If
End Sub

et celui dans le module :

Option Explicit

Sub CreationRecap_et_Facture(ByVal objList As Object)

Dim wdapp As Word.Application

Set wdapp = New Word.Application

    With wdapp
        .Visible = True
        .Activate
        .Documents.Add ThisWorkbook.Path & "\Recap_et_Facture.dotx"

        .ActiveDocument.Bookmarks("Date").Range.Text = objList.List(objList.ListIndex, 0)
        .ActiveDocument.Bookmarks("Nom").Range.Text = objList.List(objList.ListIndex, 1)
        .ActiveDocument.Bookmarks("Tel").Range.Text = objList.List(objList.ListIndex, 2)
        .ActiveDocument.Bookmarks("Mat").Range.Text = objList.List(objList.ListIndex, 3)
        .ActiveDocument.Bookmarks("Type").Range.Text = objList.List(objList.ListIndex, 4)
        .ActiveDocument.Bookmarks("Intitule").Range.Text = objList.List(objList.ListIndex, 5)
        .ActiveDocument.Bookmarks("Dateev").Range.Text = objList.List(objList.ListIndex, 5)
        .ActiveDocument.Bookmarks("Dureev").Range.Text = objList.List(objList.ListIndex, 7)
        .ActiveDocument.Bookmarks("Salle").Range.Text = objList.List(objList.ListIndex, 8)

      End With

End Sub

Dans mon document "modele" Word tous les signets sont déjà en place et tout fonctionne pour les 10 premiers signets

Fabrice

Bonsoir Fabweb,

D'abord il est possible de réduire le code

Sub Affiche(lig)
Kol = Split("F-AW-AX-AZ-AA-AC-AE-AG-AI", "-")
ListBox1.AddItem Format(Cells(lig, "D").Value, "dd/mm/yyyy")
For L = 1 To 9
N = ListBox1.ListCount - 1
ListBox1.List(N, L) = Cells(lig, Kol(L-1)).Value
Next L
End Sub

Comme tu as dèjà 10 signets de paramétrer. Où sont les 16 autres? Dans 16 cellules différentes?

Et ces cellules qui te manquent pour les insérer dans le ListBox1.

Note que si ceux sont des résultats de formules, c'est le résultat en texte qui sera nécessaire.

Bonjour X Cellus,

Merci déjà pour cette astuce de réduction de code.

Je vais développer un peu mon projet.

Des demandes de réservations de salles sont faites sur un Google Form.

Mon Excel, via Power Query va chercher les infos sur le Google Sheet associé au Form.

Dans mon Excel j’ai donc une réplique de Google Sheet (Table 0) puis à coté, d’autres tableaux avec divers formules.

Mon VBA, nous montre via la ListBox que quelques infos essentielles (en réalité 5), et en double cliquant sur la ligne qui nous intéresse, une page Word s’ouvre et nous indique tous les renseignements nécessaires (les 36 signets) pour que nous puissions imprimer.

Les cellules recherchées sont soit dans la même ligne du tableau que les infos de la listbox soit dans d’autres tableaux de ma feuille.

Une erreur dans ma réponse précédente, en fait, toutes les cellules recherchées sont dans la même ligne du tableau que les infos de la listbox

Bonsoir Fabweb,

Si je résume, sur les 9 cellules récupérées dans la ListBox1, seules 5 sont essentielles.

Et en cliquant sur une ligne de cette ListBox1, la page Word dispose de 36 signets qui doivent recevoir du texte afin que cette page ressorte sur l'imprimante.

Sauf qu'un Signet est habituellement utilisé pour marquer un emplacement dans une page. Même si on peut cibler un texte avec un Signet . Sauf que si on modifie le texte, on efface en fait le Signet et il faut le recréer.

Sous Word c'est un Champ qui est prévu spécifiquement pour recevoir du texte. Et que l'on peut modifier sans éliminer le Champ.

Donc,

.ActiveDocument.Bookmarks("Date").Range.Text = objList.List(objList.ListIndex, 0)

et les lignes suivantes vont avoir pour effet d'agir (de cibler) sur le Signet en le modifiant par le texte récupéré de la ListBox1. Mais aussi de le supprimer.

En fait, si tu essaies d'atteindre celui-ci dans la page, ce sera impossible. Ou alors cette page ne sert qu'une fois et cela est indifférent.

Pourquoi n'avoir pas fait un tableau dans ta page Word? Avec en première colonne les Date, Nom, Tél, etc... et en deuxième colonne les textes récupérés.

Une erreur dans ma réponse précédente, en fait, toutes les cellules recherchées sont dans la même ligne du tableau que les infos de la listbox

Moins clair, montre au minimum un tableau (avec données anonymes). Où sont les 5 données essentielles, les 4 autres secondaires.

Puis si une donnée essentielle est cliquée (par la ListBox) quelles colonnes (au nombre de 36) de la ligne disposent des infos.

Sans cela, c'est impossible de poursuivre...

Bonjour X Cellus,

je viens de l'envoyer par MP

Bonjour Fabweb,

En retour, modification de la macro ci-dessous concernant le double-clic sur la ListBox1.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If MsgBox("Vous allez éditer la ligne " & Me.ListBox1.ListIndex + 1, vbYesNo, "Demande de confirmation") = vbYes Then
  CreationRecap_et_Facture Me.ListBox1.ListIndex, Me.ListBox1, Me.Controls
  End If
End Sub

Et de fait, la macro les paramètres de la macro lancée.

Sub CreationRecap_et_Facture(ByVal Lind As Integer, objList, objUSF As Object)

Les Listbox même cachées peuvent être conservés tant que leurs données sont récupérables par le document.

Cela permet de partager les données entre elles et de n'afficher que celles essentielles.

A +

C'est vraiment génial , merci pour toutes ces explications et le temps consacré

Amicalement

Fabrice