Discussion :

[tcheylan]

Bonjour à tous,

Je possède une macro qui permet d'importer des titres word vers une feuille excel seulement les titres arrivent en A1.

J'aimerais que ces titres se positionnent à partir d'une cellule précise dans un tableau avec présentation, en-tête, etc.
En somme, j'aimerais que le texte en feuil2, (qui s'étend sur la colonne A et B) soit décalé vers la feuil3, à partir de la ligne 15.

J'ai essayé offset mais je ne m'en sors pas avec la "range" avec qui j'ai toujours une erreur de syntaxe (à savoir que je suis débutant en VBA).
Je n'arrive donc pas a créer une macro offset qui fonctionne, ni une macro couper/coller. Le mieux serait qu'à la suite de ma macro, je rajoute une fonction qui ferait en sorte que les titres se placent directement à la bonne place.

Quelques chose du type serait l'idéal:

-Sélectionner les cellules avec du texte (ou sélectionner de A1 à B50)
-Décaler la sélection de 15 lignes vers le bas
Problème avec cette solution : Pourrait modifier la mise en page avec l'en-tête

OU

-Sélectionner les cellules avec du texte (ou sélectionner de A1 à B50)
-Couper
-Coller a partir de A15

Merci d'avance

[Theze]

Bonjour,

Je possède une macro qui permet d'importer des titres word vers une feuille excel seulement les titres arrivent en A1

Montre le code que tu as déjà fais !

[tcheylan]

Bonjour et merci pour ta réponse,

le code n'a pas vraiment de rapport avec le problème bien qu'il est sûrement possible de le modifier sans ajouter une autre macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Sub Recuperation()
Dim WordAppli As Word.Application
'Dim ExcelAppli As Excel.Application
Dim WordDoc As Word.Document
Dim oChemin As String, oChapitre As String
Dim oWksh As Worksheet
Dim oLast As Integer, n As Integer, i As Integer, j As Integer
Dim oRng_table As Range
Dim oTable_matiere() As String, oDecomp() As String, oNewRech As String
 
With Workbooks("Nom_du_Excel.xlsm")
'Changer le titre par le titre exact de la nouvelle page excel
    With .Worksheets("Util")
        oChemin = .Range("B1")
        oChapitre = .Range("B2")
    End With
    Set oWksh = Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End With
 
 
On Error Resume Next
Set WordAppli = GetObject(, "Word.Application")
Set WordDoc = WordAppli.Documents(oChemin)
 
If WordDoc Is Nothing Then
    Set WordAppli = CreateObject("Word.Application")
    WordAppli.Documents.Open Filename:=oChemin
    Set WordDoc = WordAppli.Documents(oChemin)
End If
 
WordAppli.Visible = True
 
With WordDoc
    .TablesOfContents(1).Range.Copy
End With
 
With oWksh
    .PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
    Set oRng_table = .Columns(1).Find(oChapitre, LookIn:=xlValues, LookAt:=xlWhole)
    If Not oRng_table Is Nothing Then
        n = 1
        Do While Left(oRng_table.Offset(n - 1, 0), 1) = oChapitre
            ReDim Preserve oTable_matiere(1 To 2, 1 To n)
            If Right(oRng_table.Offset(n - 1, 0), 1) = "." Then
                oTable_matiere(1, n) = oRng_table.Offset(n - 1, 0)
            Else
                oTable_matiere(1, n) = oRng_table.Offset(n - 1, 0) & "."
            End If
            oTable_matiere(2, n) = oRng_table.Offset(n - 1, 1)
            n = n + 1
        Loop
    Else
        MsgBox "Le chapitre souhaité n'est pas présent dans le document."
        Exit Sub
    End If
End With
 
With Workbooks("Nom_du_Excel.xlsm").Worksheets("DPGF")
'Changer le titre par le titre exact de la nouvelle page excel
    For i = LBound(oTable_matiere, 2) To UBound(oTable_matiere, 2)
        Set oRng_table = .Columns(1).Find(oTable_matiere(1, i), LookIn:=xlValues, LookAt:=xlWhole)
        If oRng_table Is Nothing Then
            oDecomp() = Split(oTable_matiere(1, i), ".")
 
            n = 1
            Do While True
                oNewRech = ""
                For j = LBound(oDecomp) To UBound(oDecomp) - n
                    oNewRech = oNewRech & oDecomp(j) & "."
                Next j
 
                Set oRng_table = .Columns(1).Find(oNewRech, LookIn:=xlValues, LookAt:=xlWhole)
                If oRng_table Is Nothing Then
                    If Compte_point(oNewRech) > 2 Then
                        n = n + 1
                    Else
                        Call Creation_chapitre(oTable_matiere(1, i), oTable_matiere(2, i))
                        Exit Do
                    End If
                Else
                    Call Creation_intitule(oTable_matiere(1, i), oTable_matiere(2, i), oRng_table)
                    Exit Do
                End If
            Loop
        End If
    Next i
    Application.DisplayAlerts = False
    oWksh.Delete
    Application.DisplayAlerts = True
    .Select
End With
 
End Sub
 
Sub Creation_chapitre(oChap As String, oIntit As String)
Dim oRng As Range
 
With Workbooks("Nom_du_Excel.xlsm").Worksheets("DPGF")
'Changer le titre par le titre exact de la nouvelle page excel
    Set oRng = .Cells(.Rows.Count, 1).End(xlUp)
    oRng.Offset(1, 0).EntireRow.Insert
    oRng.Offset(1, 0).EntireRow.Insert
 
    oRng.Offset(2, 0) = oChap
    oRng.Offset(2, 1) = oIntit
 
    oRng.Offset(2, 0).EntireRow.Font.Color = RGB(0, 0, 0)
End With
 
End Sub
 
Sub Creation_intitule(oChap As String, oIntit As String, oRng_table As Range)
 
With oRng_table
    .Offset(1, 0).EntireRow.Insert
 
    .Offset(1, 0) = oChap
    .Offset(1, 1) = oIntit
 
    .Offset(1, 0).EntireRow.Font.Color = RGB(0, 0, 0)
End With
 
End Sub
 
Function Compte_point(oStr As String) As Integer
Dim i As Integer
Dim oCount As Integer
 
For i = 1 To Len(oStr)
    If Mid(oStr, i, 1) = "." Then
        oCount = oCount + 1
    End If
Next i
 
Compte_point = oCount
End Function

Ce code fonctionne très bien pour ce que je veux en faire, j'aimerais seulement que les titres se positionnent où je le souhaite (à partir de A15)
Cordialement.