user_mobilelogo

Word 365: Vous saurez tout !

Pour tout connaître sur Word
Nouvelle version !

600 pages !

9,80 € 

 

En savoir plus.

Voici une macro qui permet de faire la somme des nombres d'une colonne d'un tableau, quel que soit le format de ces nombres.

Cette macro :

  • repère où se trouve le point d'insertion (la cellule où on veut faire apparaître la somme)
  • supprime tous les espaces éventuels placés avant un texte ou un nombre situés dans la colonne concernée
  • supprime tous les espaces (séparateurs de milliers par exemple) dans les nombres de la colonne
  • met des zéros dans les cellules vides concernées par le calcul
  • insère la formule de somme, calcule le résultat, et formate ce dernier ainsi que les nombres de la colonne qui ont été utilisés pour l'obtenir.

Par défaut, le résultat est arrondi à 2 décimales, mais on peut en changer (on peut se faire une macro pour arrondir à l'entier le plus proche, et lui affecter un bouton). Inconvénient : si on supprime les décimales, et qu'on veut ensuite les récupérer, c'est impossible : elles sont perdues.

 

Sub SommeColonneTableau()
'macro écrite par André Barelier
Dim Contenu As String
Dim NbCol As Integer
Dim NbLig As Integer
Dim NbCel As Long
Dim i As Long
If Selection.Information(wdWithInTable) = True Then
With Selection
'repérage de la cellule où on veut mettre la formule
ligne = .Information(wdStartOfRangeRowNumber)
colonne = .Information(wdStartOfRangeColumnNumber)
End With
Selection.Tables(1).Select
For i = 1 To ligne - 1 'balayage des cellules au dessus
ActiveDocument.Tables(1).Cell(i, colonne).Select
Contenu = Selection.Text
terme1 = Asc(Contenu)
If terme1 = 32 Then 'élimination des blancs en début de texte
Selection.Find.Execute FindText:="^w", ReplaceWith:="",
Replace:=wdReplaceAll
End If
If terme1 = 45 Or terme1 = 43 Then 'élimine espaces après - ou +
Selection.Find.Execute FindText:="^w", ReplaceWith:="",
Replace:=wdReplaceAll
End If
If terme1 > 47 And terme1 < 58 Then
'élimination des séparateurs éventuels dans les nombres
Selection.Find.Execute FindText:="^w", ReplaceWith:="", _
Replace:=wdReplaceAll
End If
If terme1 < 32 Then Selection.TypeText Text:="0"
'mettre zéro dans les cellules vides
Next i
Selection.Tables(1).Cell(ligne, colonne).Select
Selection.Delete 'enlever le zéro
Selection.InsertFormula Formula:="=SUM(ABOVE)", NumberFormat:="# ##0.00"
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
For i = 1 To ligne - 1
Selection.Tables(1).Cell(i, colonne).Select
If Val(Selection.Text) <> 0 Then
Selection.Text = Format(Val(Selection.Text), "# ### ### ##0.00")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End If
Next i
Else
MsgBox "Mettre le point d'insertion dans un tableau"
End If
End Sub



Formatage nombres entiers (avec prise en compte des nombres négatifs)



Sub FormatageNombreEntier()
'macro écrite par André Barelier
With Selection
ligneDebut = .Information(wdStartOfRangeRowNumber)
colonneDebut = .Information(wdStartOfRangeColumnNumber)
ligneFin = .Information(wdEndOfRangeRowNumber)
colonneFin = .Information(wdEndOfRangeColumnNumber)
End With
For i = ligneDebut To ligneFin
For j = colonneDebut To colonneFin
Selection.Tables(1).Cell(i, j).Select
Contenu = Selection.Text
terme1 = Asc(Contenu)
If terme1 = 32 Then
'élimination des blancs éventuels en début de texte
Selection.Find.Execute FindText:="^w", ReplaceWith:="", _
Replace:=wdReplaceAll
End If
If terme1 > 48 And terme1 < 58 Then
'élimination des séparateurs éventuels dans les nombres
Selection.Find.Execute FindText:="^w", ReplaceWith:="", _
Replace:=wdReplaceAll
End If
Next j
Next i
For i = ligneDebut To ligneFin
For j = colonneDebut To colonneFin
Selection.Tables(1).Cell(i, j).Select
Contenu = Selection.Text
If Asc(Contenu) = 45 Or (Asc(Contenu) > 48 And _
Asc(Contenu) < 58Then
Selection.Text = Format(Val(Selection.Text), _
"# ### ### ##0")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End If
Next j
Next i
End Sub

 

 

Statistiques

Aujourd'hui76
Hier1504
Cette semaine17846
Ce mois14562
Total depuis 200412618963

11
visiteurs actuellement en ligne

6 décembre 2020