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 |
Partager