Macro pour des cases à cocher

Merinom

XLDnaute Junior
Bonjour à tout le monde!

Je demande votre aide avec un petit soucis que j'ai. J'ai une macro qui remplie un fichier Word avec des infos sur mon fichier Excel, ce que je voudrais c'est qu'on puisse sélectionner les infos à l'aide de cases à cocher qu'on veut mettre dans mon fichier Word. La macro que j'ai fait marche à travers des signets.

Un autre petit soucis est que je voudrais optimiser un formule SI avec des imbrications, car on peut faire seulement 64 imbrications ... A l'aide d'une macro sa devrait aller plus vite mais je ne sais pas comment faire, dans le fichier joint Feuil2 cellule C20 vous trouverai cette formule infernale qui me permet d'extraire une liste de la Feuil1.

Je vous laisse le fichier Excel en PJ. Merci beaucoup!
 

Pièces jointes

  • Etiquettage.xlsm
    164.7 KB · Affichages: 52

piga25

XLDnaute Barbatruc
Bonjour,

N'étant pas un spécialiste des macros, peut être qu'une autre personne pourra de dépanner.
Néanmoins j'ai regardé ta macro ListeEttiquete() et je pense qu'en lui incluant des boucles cela doit la simplifier.
Voir si cela fonctionne
Code:
Sub ListeEttiquete()

    Dim WordObj As Object, Doc As Object
    Dim i&, j&
    Set WordObj = CreateObject("Word.Application")
    Const wdGoToBookmark = -1

    WordObj.Visible = True

    'Ouvre le document modèle existant dans le répertoire spécifique

    Set Doc = WordObj.Documents.Open("C:\Users\martin\Desktop\etiquettes.doc")
    For i = 20 To 61
    For j = 1 To 41

    With WordObj.Selection ' assignation des signets
        .GoTo What:=wdGoToBookmark, Name:="tube&j" ' recherche du signet - ' remplissage 1ere en tête
        .TypeText Text:=Cells(3, i).Text ' remplacer le signet par le texte de la cellule B3
              
        ' Signet dimensions
        .GoTo What:=wdGoToBookmark, Name:="dim&j"
        .TypeText Text:=[D11].Text
       
        'Signets coulée
        .GoTo What:=wdGoToBookmark, Name:="coulee&j"
        .TypeText Text:=[D9].Text
       
        'Signets lots
        .GoTo What:=wdGoToBookmark, Name:="lot&j"
        .TypeText Text:=[D8].Text
       
    End With
        Next
        Next

    Set Doc = Nothing
    Set WordObj = Nothing

End Sub
 

Merinom

XLDnaute Junior
Bonjour,

Merci pour l'attention que tu portes à mon problème. J'ai essayé le code que tu m'as donné mais lors de l'exécution j'ai l'erreur "Ce signet n'existe pas" et le déboguer surligne .GoTo What:=wdGoToBookmark, Name:="tube&j" . Je crois qu'il ne comprend pas la notation tube&j .
 

piga25

XLDnaute Barbatruc
Bonjour,

Peut être comme ceci
Code:
Sub ListeEttiquete()

    Dim WordObj As Object, Doc As Object
    Dim i&, j&
    Set WordObj = CreateObject("Word.Application")
    Const wdGoToBookmark = -1

    WordObj.Visible = True

    'Ouvre le document modèle existant dans le répertoire spécifique

    Set Doc = WordObj.Documents.Open("C:\Users\martin\Desktop\etiquettes.doc")
    For i = 20 To 61
    For j = 1 To 41

    With WordObj.Selection ' assignation des signets
        .GoTo What:=wdGoToBookmark, Name:="tube" & "j" ' recherche du signet - ' remplissage 1ere en tête
        .TypeText Text:=Cells(3, i).Text ' remplacer le signet par le texte de la cellule B3
             
        ' Signet dimensions
        .GoTo What:=wdGoToBookmark, Name:="dim" & "j"
        .TypeText Text:=[D11].Text
      
        'Signets coulée
        .GoTo What:=wdGoToBookmark, Name:="coulee" & "j"
        .TypeText Text:=[D9].Text
      
        'Signets lots
        .GoTo What:=wdGoToBookmark, Name:="lot" & "j"
        .TypeText Text:=[D8].Text
      
    End With
        Next
        Next

    Set Doc = Nothing
    Set WordObj = Nothing

End Sub

C'est un essai car le VBA et moi cela fait 2
 

Merinom

XLDnaute Junior
Bonjour,

J'ai trouvé la bonne syntaxe :

Code:
Sub ListeEttiquete()

    Dim WordObj As Object, Doc As Object
    Dim I As Integer

    Set WordObj = CreateObject("Word.Application")

    Const wdGoToBookmark = -1

    WordObj.Visible = True

    'Ouvre le document modèle existant dans le répertoire spécifique
   Set Doc = WordObj.Documents.Open("C:\Users\martin\Desktop\etiquettes.doc")

    With WordObj.Selection ' assignation des signets
 
        For I = 1 To 42
      
            .GoTo What:=wdGoToBookmark, Name:="tube" & I ' recherche du signet - ' remplissage 1ere en tête
           .TypeText Text:=Range("C" & I + 19).Text ' remplacer le signet par le texte de la cellule B3
         
            .GoTo What:=wdGoToBookmark, Name:="dim" & I 'Signet dimensions
           .TypeText Text:=Range("D11").Text
          
            .GoTo What:=wdGoToBookmark, Name:="coulee" & I 'Signets coulée
           .TypeText Text:=Range("D9").Text
          
            .GoTo What:=wdGoToBookmark, Name:="lot" & I 'Signets lots
           .TypeText Text:=Range("D8").Text
          
        Next I
              
    End With

    Set Doc = Nothing

    Set WordObj = Nothing

End Sub

Je ne sais pas encore faire pour les cases à cocher. Il faudrait faire quelque chose comme :



Code:
If CheckBox1.Value = 1 Then
           .GoTo What:=wdGoToBookmark, Name:="dim" & I 'Signet dimensions
          .TypeText Text:=Range("D11").Text

Else *Ne pas remplir les signets*
 

Discussions similaires

Réponses
5
Affichages
249

Statistiques des forums

Discussions
312 875
Messages
2 093 143
Membres
105 638
dernier inscrit
cordier