[VBA - W] Boucle IF et format de police [Résolu]

[perophron]

Bonjour.
Je souhaiterais savoir si quelqu'un peut m'indiquer la commande qui permet de réaliser une instruction à l'aide d'une boucle IF si le texte est en gras et souligné.
J'ai ce début de code :

Code :

1
2
 
b = Left(objTable.Cell(i, 1).Range.Text, InStr(objTable.Cell(i, 1).Range.Text, vbCr) - 1)

et vient ensuite la boucle :
Si b est en gras et souligné,
alors commande.

Merci d'avance

[Heureux-oli]

Code :

1
2
3
4
5
6
Public Sub testFont()
If Selection.Font.Bold Then MsgBox "gras"
If Selection.Font.Underline Then MsgBox "Souligné"
 
 
End Sub

[perophron]

Ok
et pour mettre les conditions gras et souligné ensemble, suffit-il de les relier par &?

Code :

If Selection.Font.Bold & Selection.Font.Underline Then MsgBox "gras et souligné"

[Heureux-oli]

As-tu essayé ?

[perophron]

Non car je n'arrive pas à faire le lien entre le code du premier post et ce que tu m'as indiqué.
Faut-il simplement écrire

Code :

1
2
 
If b = Selection.Font.Bold & Selection.Font.Underline Then MsgBox "gras et souligné"

ou autre chose?

[Heureux-oli]

Faire une macro demande de respecter certaines choses.

Savoir dès le départ ce que l'on veut faire !!

A voir ton code, tu n'a même pas consulté l'aide ni la faq.

l'opérateur "&" et oui c'est un opérateur, est un opérateur de concaténation en VBA.

Il est donc fort peu probable qu'il fonctionne comme tu le voudrais.

Dans la première ligne de code que tu présente, tu affecte à b une valeur.
Valeur dont je ne connais pas le type.

Si ne représente en rien une boucle !! si est un opérateur de condition.

If fonctionne de la manière suivante :

Code :

1
2
3
4
5
6
 
If MonTestLogique then
    Action si vrai
Else
    Action si faux
End if

ans ton cas, on doit faire deux tests tu ne veux un résultat que si les deux tests sont vrais.

Code :

1
2
3
4
5
6
 
if b.font.bold then
     if b.font.underline then
         mon action
     end if
end if

[perophron]

Ok je te donne le code que j'ai composé en te l'expliquant :

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
Sub recapitulatif()
Dim objTable As Table
Dim i As Integer
Dim a As String
Dim b As String
Set objTable = ThisDocument.Tables(1)
Dim stTemp As String
Dim nbr As Integer
  nbr = 0
  stTemp = ActiveDocument.Name
For i = 1 To objTable.Rows.Count
    b = Left(objTable.Cell(i, 1).Range.Text, InStr(objTable.Cell(i, 1).Range.Text, vbCr) - 1)
    If b.Font.Bold Then
      If b.Font.Underline Then
        objTable.Rows(i).Select
        Selection.Copy
        Documents.Open FileName:="C:\Récap.doc"
        Selection.EndKey Unit:=wdLine
        Selection.PasteAndFormat (wdPasteDefault)
        nbr = nbr + 1
     End If
    Else
    a = Left(objTable.Cell(i, 2).Range.Text, InStr(objTable.Cell(i, 2).Range.Text, vbCr) - 1)
      If a = "D" Then
        objTable.Rows(i).Select
        Selection.Copy
        Documents.Open FileName:="C:\Récap.doc"
        Selection.EndKey Unit:=wdLine
        Selection.PasteAndFormat (wdPasteDefault)
        objTable.Cell(i, 1).Select
        If Selection.Font.Underline = wdUnderlineSingle Then
           Selection.Font.Underline = wdUnderlineNone
        End If
        nbr = nbr + 1
      End If
    End If
Next i
  Selection.MoveUp Unit:=wdLine, Count:=nbr
  Selection.InsertRowsAbove 1
  Selection.TypeText Text:=Left(stTemp, InStr(stTemp, ".doc") - 1)
  Selection.EndKey Unit:=wdStory
End Sub

La confusion sur le terme boucle pour If vient du fait que j'utilise une boucle For.
Cette macro est censé renvoyer sur le document Récap.doc :
-les lignes du tableau d'un autre document dont la lettre de la deuxième colonne est "D"
-les lignes constituant des titres en gras et soulignés
-le nom du document dont ces lignes sont issues.

Il y a pas mal de lignes de code de mise en forme car en rajoutant une ligne ont obtient parfois une mise en forme non voulue.

J'ai un problème avec cette macro : elle s'arrête dès que la première ligne contenant "D" est collée sur Récap.doc.
Peux-tu m'aider à résoudre ce problème?

Pour mieux comprendre ce que je veux faire et peut-être en guise de base de réflexion je joins la première version de cette macro qui fonctionne:

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
Sub recapitulatif()
Dim objTable As Table
Dim i As Integer
Dim a As String
Set objTable = ThisDocument.Tables(1)
Dim stTemp As String
Dim nbr As Integer
nbr = 0
stTemp = ActiveDocument.Name
For i = 1 To objTable.Rows.Count
    a = Left(objTable.Cell(i, 2).Range.Text, InStr(objTable.Cell(i, 2).Range.Text, vbCr) - 1)
    If a = "D" Then
        objTable.Rows(i).Select
        Selection.Copy
  Documents.Open FileName:="C:\Récap.doc", _
    ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
    PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
    WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
    wdOpenFormatAuto, XMLTransform:="", DocumentDirection:=wdLeftToRight
  Selection.PasteAndFormat (wdPasteDefault)
  nbr = nbr + 1
    End If
Next i
  Selection.MoveUp Unit:=wdLine, Count:=nbr
  Selection.InsertRowsAbove 1
  Selection.TypeText Text:=stTemp
End Sub

en te remerciant d'avance...

[Heureux-oli]

Voilà la macro elle devrait fonctionner.

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
49
50
 
Public Sub testolivier()
Dim objTable As Table
Dim i As Integer
Dim a As String
Dim b As Boolean
Dim s As Boolean
Dim t As Boolean
Set objTable = ThisDocument.Tables(1)
Dim stTemp As String
Dim nbr As Integer
nbr = 0
stTemp = ActiveDocument.Name
Documents.Open FileName:="C:\temp\Recap.doc"
For i = 1 To objTable.Rows.Count
 
    b = objTable.Rows(i).Cells(1).Range.Font.Bold
    s = objTable.Rows(i).Cells(1).Range.Font.Underline
    t = b And s
 
    a = Left(objTable.Cell(i, 2).Range.Text, InStr(objTable.Cell(i, 2).Range.Text, vbCr) - 1)
 
        If a = "D" Then
            objTable.Rows(i).Select
            Selection.Copy
            Documents("Recap.doc").Activate
            Selection.EndKey Unit:=wdLine
            Selection.PasteAndFormat (wdPasteDefault)
        Else
            If t = True Then
                objTable.Rows(i).Select
                Selection.Copy
                Documents("Recap.doc").Activate
                Selection.EndKey Unit:=wdLine
                Selection.PasteAndFormat (wdPasteDefault)
                objTable.Cell(i, 1).Select
                If Selection.Font.Underline = wdUnderlineSingle Then
                    Selection.Font.Underline = wdUnderlineNone
                End If
            End If
        End If
nbr = nbr + 1
Next i
    Documents("Recap.doc").Activate
    ActiveDocument.Tables(1).Rows(1).Cells(1).Select
    Selection.InsertRowsAbove 1
    Selection.TypeText Text:=Left(stTemp, InStr(stTemp, ".doc") - 1)
    Selection.EndKey Unit:=wdStory
 
End Sub

[perophron]

Ok sympa
Après les quelques modifications qui s'imposent (chemin du fichier à ouvrir, position du tableau dans le document, etc) j'ai essayé la macro mais elle ne marche pas:
-aucun texte n'apparait dans le récapitulatif
-du coup la macro m'insulte car ActiveDocument.Tables(1).Rows(1).Cells(1).Select n'existe pas

[Heureux-oli]

Voilà les deux fichiers que j'ai utilisés.
Ils sont à mettre dans le C:\temp\

[perophron]

J'essaie et ça marche pas.
J'ai une insulte qui dit:
Erreur system &H80004005 (-2147467259). Erreur non spécifiée

[perophron]

Je te renvoie la macro que j'ai légérement modifié comme je l'ai dis précédemment au cas où j'y aurait fait des erreurs.

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
49
Private Sub CommandButton1_Click()
Dim objTable As Table
Dim i As Integer
Dim a As String
Dim b As Boolean
Dim s As Boolean
Dim t As Boolean
Set objTable = ThisDocument.Tables(4)
Dim stTemp As String
Dim nbr As Integer
nbr = 0
stTemp = ActiveDocument.Name
Documents.Open FileName:="C:\Documents and Settings\Moi\Bureau\Essai récapitulatif b.doc"
For i = 1 To objTable.Rows.Count
 
    b = objTable.Rows(i).Cells(1).Range.Font.Bold
    s = objTable.Rows(i).Cells(1).Range.Font.Underline
    t = b And s
 
    a = Left(objTable.Cell(i, 2).Range.Text, InStr(objTable.Cell(i, 2).Range.Text, vbCr) - 1)
 
        If a = "D" Then
            objTable.Rows(i).Select
            Selection.Copy
            Documents("Essai récapitulatif b.doc").Activate
            Selection.EndKey Unit:=wdLine
            Selection.PasteAndFormat (wdPasteDefault)
        Else
            If t = True Then
                objTable.Rows(i).Select
                Selection.Copy
                Documents("Essai récapitulatif b.doc").Activate
                Selection.EndKey Unit:=wdLine
                Selection.PasteAndFormat (wdPasteDefault)
                objTable.Cell(i, 1).Select
                If Selection.Font.Underline = wdUnderlineSingle Then
                    Selection.Font.Underline = wdUnderlineNone
                End If
            End If
        End If
nbr = nbr + 1
Next i
    Documents("Essai récapitulatif b.doc").Activate
    ActiveDocument.Tables(1).Rows(1).Cells(1).Select
    Selection.InsertRowsAbove 1
    Selection.TypeText Text:=Left(stTemp, InStr(stTemp, ".doc") - 1)
    Selection.EndKey Unit:=wdStory
 
End Sub

[Heureux-oli]

Essaie de faire du monitoring de ton code avec quelques

Code :

Debug.print

sur les variables.

[perophron]

Salut
j'ai trouvé une partie de ce qui allait pas dans le code que j'ai un peu retouché.
J'utilise un modèle de document dans lequel est placé la macro.
En général, lorsque l'on créé des documents à partir de ces modèles, j'ai remarqué qu'il vaut mieux utiliser ActiveDocument plutôt que ThisDocument qui a tendance à faire référence au modèle et donc au mauvais document.
Depuis que j'ai apporté cette modification, les avis sont bien envoyé sur le document Récap.
Seulement, la macro plante lorsqu'il s'agit d'ajouter le nom du document, à la quatrième ligne en partant de la fin:

Code :

    Selection.TypeText Text:=Left(stTemp, InStr(stTemp, ".doc") - 1)

alors que mon document est bien un .doc.

Je cherche à résoudre ce petit inconvénient mais si tu as le temps d'y jeter un coup d'oeil...

[perophron]

Voilà ça y'est j'ai trouvé.
Il suffisait d'enregistrer le document avant de lancer la macro, et elle fonctionne nickel chrome.
Merci Heureux-Oli, du coup je peux apposer le résolu à deux sujets en même temps.

[Heureux-oli]

Essaie juste avant la ligne de mettre un

Code :

Debug.print stTemp

Pour savoir ce qu'il contient