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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
Option Explicit
Public MatriceSauts() As Variant
Public IndexP As Long
Sub DeleteSautLigneVide2()
Dim HeureDebut2, HeureFin2, TempsTotal2
Dim DocEnCours As Document
Dim I As Long
Dim PositionChaine As Integer
HeureDebut2 = Timer ' Définit l'heure de début.
Application.ScreenUpdating = False
Set DocEnCours = Documents("exemple (1).docx")
With DocEnCours
Selection.HomeKey unit:=wdStory
'vérifie la longueur du paragraphe
IndexP = 0
For I = .Paragraphs.Count To 1 Step -1
With .Paragraphs(I).Range
If InStr(1, .Text, Chr(13), vbTextCompare) > 0 _
Or InStr(1, .Text, Chr(12), vbTextCompare) > 0 _
Or InStr(1, .Text, Chr(11), vbTextCompare) > 0 _
Or InStr(1, .Text, Chr(10), vbTextCompare) > 0 Then
ReDim Preserve MatriceSauts(5, IndexP)
MatriceSauts(0, IndexP) = I
MatriceSauts(1, IndexP) = Len(.Text)
MatriceSauts(2, IndexP) = InStr(1, .Text, Chr(13), vbTextCompare)
MatriceSauts(3, IndexP) = InStr(1, .Text, Chr(12), vbTextCompare)
MatriceSauts(4, IndexP) = InStr(1, .Text, Chr(11), vbTextCompare)
MatriceSauts(5, IndexP) = InStr(1, .Text, Chr(10), vbTextCompare)
IndexP = IndexP + 1
End If
End With
Next I
DeverserLesResulatsDansExcel DocEnCours
End With
Set DocEnCours = Nothing
Application.ScreenUpdating = True
'MsgBox "Sauts de ligne inutiles effacés chef!"
' For IndexP = LBound(MatriceSauts, 2) To UBound(MatriceSauts, 2)
' Debug.Print "P : " & MatriceSauts(0, IndexP) & ", Nb Car : " & MatriceSauts(1, IndexP) _
' & ", Chr(13) : " & MatriceSauts(2, IndexP) & ", Chr(12) : " & MatriceSauts(3, IndexP) _
' & ", Chr(11) : " & MatriceSauts(4, IndexP) & ", Chr(10) : " & MatriceSauts(5, IndexP)
' Next IndexP
HeureFin2 = Timer ' Définit l'heure de fin.
TempsTotal2 = HeureFin2 - HeureDebut2 ' Calcule la durée totale.
Debug.Print "Chef ! Chef ! J'ai mis " & Round(TempsTotal2, 1) & " seconde(s) pour traiter la procédure DeleteSautLigneVide !"
MsgBox "Temps total du traitement DeleteSautLigneVide : " & Round(TempsTotal2, 1) & " seconde(s)"
End Sub
Sub DeverserLesResulatsDansExcel(ByVal DocEnCours2 As Document)
Dim xlApp As Object
Dim FichierExcel As Object, ShExcel As Object
Dim FichierAOuvrir As Variant
Dim Repertoire As String
Set xlApp = CreateObject("Excel.Application")
Repertoire = DocEnCours2.Path ' A adapter
'FichierAOuvrir = Repertoire & "\" & "fichier_liste.xlsm"
With xlApp
.Visible = True
Set FichierExcel = .workbooks.Add
With FichierExcel
Set ShExcel = .sheets(1)
With ShExcel
.Range(.Cells(1, 1), .Cells(1, 6)) = Array("Paragraphe", "Nb car", "Chr(13)", "Chr(12)", "Chr(11)", "Chr(10)")
For IndexP = LBound(MatriceSauts, 2) To UBound(MatriceSauts, 2)
.Cells(IndexP + 2, 1) = MatriceSauts(0, IndexP)
.Cells(IndexP + 2, 2) = MatriceSauts(1, IndexP)
.Cells(IndexP + 2, 3) = MatriceSauts(2, IndexP)
.Cells(IndexP + 2, 4) = MatriceSauts(3, IndexP)
.Cells(IndexP + 2, 5) = MatriceSauts(4, IndexP)
.Cells(IndexP + 2, 6) = MatriceSauts(5, IndexP)
Next IndexP
End With
Set ShExcel = Nothing
' .Close savechanges:=False
End With
Set FichierExcel = Nothing
End With
'xlApp.Quit
Set xlApp = Nothing
End Sub |
