Re : Créer des équipes au hasard (ou presque...)
... bon, je vais être très très lourd là
mais il y a un truc qui ne fonctionne plus !...
avant ma présentation était comme ça :
Prénom ; Nom ; Ecole ; Numéro d'équipe ; Pays
et avec cette belle liste, je créé des étiquettes dans word!... avec ça :
Sub PilotageWord()
' Création de l'objet word, et attribution d'une valeur
' Attention, pour pouvoir utiliser ces méthodes il faut aller dans Outils/Références et cocher la case "Microsoft Word 12.0 Object Library"
Dim MyWord As Object
Set MyWord = New Word.Application
' Objets utiles au parcours du tableau
Dim nbLignes, indexLigne
Dim initTab As Range
'Initialisation
indexLigne = 1
nbLignes = 0
' On dit où se trouve la première case
Set initTab = Range("A1")
' Ouvrir Word
MyWord.WindowState = wdWindowStateMaximize
MyWord.Visible = True
' Code de Macro Word :
' Création d'un nouveau document
MyWord.Documents.Add
'On compte le nombre de lignes de la table
While initTab.Offset(nbLignes + 1, 0) <> 0
nbLignes = nbLignes + 1
Wend
' Tableau
MyWord.ActiveDocument.Tables.Add Range:=MyWord.Selection.Range, NumRows:=1, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With MyWord.Selection.Tables(1)
If .Style <> "Grille du tableau" Then
.Style = "Grille du tableau"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
'On recompte le nombre de lignes de ta table
nbLignes = 0
While initTab.Offset(nbLignes, 0) <> 0
nbLignes = nbLignes + 1
Wend
'Pour chaque ligne de la table, on ajoute une case au tableau
While indexLigne < nbLignes
With MyWord.Selection
'.Font.Bold = True
.Font.Size = 12
'.Font.Name = "Arial"
End With
MyWord.Selection.TypeText Text:=initTab.Offset(indexLigne, 0).Value & " " & _
UCase(initTab.Offset(indexLigne, 1).Value)
MyWord.Selection.TypeParagraph
MyWord.Selection.TypeParagraph
MyWord.Selection.TypeParagraph
With MyWord.Selection
.Font.Bold = True
.Font.Size = 24
'.Font.Name = "Arial"
End With
MyWord.Selection.TypeText Text:=UCase(initTab.Offset(indexLigne, 4).Value)
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
MyWord.Selection.Font.Size = 12
MyWord.Selection.TypeParagraph
MyWord.Selection.TypeParagraph
MyWord.Selection.TypeParagraph
With MyWord.Selection
.Font.Italic = True
.Font.Size = 11
'.Font.Name = "Arial"
End With
MyWord.Selection.TypeText Text:="Ecole : " & initTab.Offset(indexLigne, 2).Value
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
MyWord.Selection.MoveRight Unit:=wdCell
indexLigne = indexLigne + 1
Wend
' Impression
'MyWord.Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
' wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
' ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
' False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
' PrintZoomPaperHeight:=0
' Ecriture d'un texte
' MyWord.Selection.TypeText ActiveCell.Value
'Enregistrement
'MyWord.ActiveDocument.SaveAs "essaiTableau.docx"
'Fermeture du document
' MyWord.ActiveDocument.Close
' Libération de la mémoire
Set MyWord = Nothing
End Sub
mais alors maintenant ça ne marche pluus ! tu saurais adapter l'un ou l'autre des programmes ?! après c'est fini lol !
merci bcp