WORD ET EXCEL

Question

J'ai un fichier word avec un macro qui ouvre un fichier excel le referme et produit un r&#233;sultat dans word sans jamais "voir" excel. Mon probl&#232;me est le suivant y a t il moyen d'inclure le fichier excel  au fichier word afin de ne plus avoir qu'un seul fichier ?
merci

Raphex

cs_Emcy · Answer

bonjours,

moi je fais l'inverse je lance une macro excel qui copie un tableau excel dans un fichier word.

je de donne le code en vrac : tu devrais trouver &#224; l'interieur tout ce dont tu as besoin :

Sub Word()


Dim WordObj As Object
Dim WordFile As Object
Dim NewTextBox As Object
Dim NewTable As Object
Dim aTable As Object
Dim aPage As Integer
Dim NbTable As Integer
Dim NbLigne As Integer
Dim NbLigneOld As Integer
Dim NbCellules As Integer
Dim FirstPage As Boolean
Dim PowerObj As Object
Dim PowerObjNameRefDessus As String
Dim PowerObjNameRefDessous As String
Dim PowerObjNameValDessus As String
Dim PowerObjNameValDessous As String
Dim Multi As Single
Dim MultiLargeur As Single
Dim MultiHauteur As Single
Dim ObjetLargeur As Single
Dim ObjetHauteur As Single
Dim HauteurMax As Single
Dim LargeurMax As Single
Dim DecalageX As Single
Dim DecalageY As Single
Dim BordureX As Single
Dim BordureY As Single
Dim SousZoneText As Object
Dim Temp1 As String
Dim Temp2 As String
Dim ObjTemp As Object


On Error Resume Next
Set ObjTemp = Worksheets("ERREUR")
If Err Then
    MsgBox ("Veuillez cr&#233;er le Tableau avant de l'exporter vers Word !")
    Exit Sub
Else
    Temp1 = Sheets("Infos").Range("B3").Value
    Temp2 = Sheets("Infos").Range("B2").Value
    Temp2 = Left(Temp2, Len(Temp2) - 4)
    PowerObjNameRefDessus = Temp1 + "" + Temp2 + "(RefFC).pcb"
    PowerObjNameRefDessous = Temp1 + "" + Temp2 + "(RefFS).pcb"
    PowerObjNameValDessus = Temp1 + "" + Temp2 + "(ValFC).pcb"
    PowerObjNameValDessous = Temp1 + "" + Temp2 + "(ValFS).pcb"
End If
On Error GoTo 0


Call OuvrirIni
FirstPage = True


Application.ScreenUpdating = False


'On Error Resume Next
Set WordObj = CreateObject("Word.Application")


WordObj.Visible = True
'WordObj.ScreenUpdating = False
Set WordFile = WordObj.Documents.Open(CartoucheNomenclatureWord)  'ouvre la nomenclature Word


WordFile.ActiveWindow.ActivePane.View.SeekView = 9


'If WordObj.Selection.HeaderFooter.Shapes(1).GroupItems.Count > 1 Then ' determine si l'objet est group^&#233;


For Each SousZoneText In WordObj.Selection.HeaderFooter.Shapes(1).GroupItems  'C'est ici que l'on passe en revue tous les objets du groupe (en esp&#233;rant qu'il n'y ait pas de sous-groupe...)
    SousZoneText.TextFrame.TextRange = "aaa"
Next


'WordObj.Selection.HeaderFooter.Shapes(1).Select
WordObj.ActiveWindow.ActivePane.View.SeekView = 0



'ins&#233;re plan ref dessus
If Dir(PowerObjNameRefDessus) = "" Then
    PowerObjNameRefDessus = ""
End If


WordFile.Range(Start:=3, End:=3).Select
Set NewTextBox = WordFile.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=35, Top:=72, Width:=30, Height:=30)
NewTextBox.TextFrame.TextRange.Select


Set PowerObj = WordObj.Selection.InlineShapes.AddOLEObject(ClassType:="PowerPCB.Design", Filename:=PowerObjNameRefDessus, LinkToFile:=False, DisplayAsIcon:=False)


'Redimensionnement de l'objet
LargeurMax = 568
HauteurMax = 380
BordureX = 14.45
BordureY = 20.8
ObjetLargeur = PowerObj.Width
ObjetHauteur = PowerObj.Height
MultiLargeur = LargeurMax / ObjetLargeur
MultiHauteur = HauteurMax / ObjetHauteur


If MultiLargeur < MultiHauteur Then
    Multi = MultiLargeur
Else
    Multi = MultiHauteur
End If


ObjetLargeur = ObjetLargeur * Multi 'agrandissement de l'objet
ObjetHauteur = ObjetHauteur * Multi


If MultiLargeur < MultiHauteur Then
    DecalageY = (HauteurMax - (ObjetHauteur + BordureY)) / 2
    NewTextBox.Top = NewTextBox.Top + DecalageY
Else
    DecalageX = (LargeurMax - (ObjetLargeur + BordureX)) / 2
    NewTextBox.Left = NewTextBox.Left + DecalageX
End If


PowerObj.Width = ObjetLargeur
PowerObj.Height = ObjetHauteur
NewTextBox.Width = ObjetLargeur + BordureX
NewTextBox.Height = ObjetHauteur + BordureY
NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text


 


 


'ins&#233;re plan valeur dessus
WordFile.Range(Start:=7, End:=7).Select
Set NewTextBox = WordFile.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=35, Top:=72, Width:=30, Height:=30)
NewTextBox.TextFrame.TextRange.Select
Set PowerObj = WordObj.Selection.InlineShapes.AddOLEObject(ClassType:="PowerPCB.Design", Filename:=PowerObjNameValDessus, LinkToFile:=False, DisplayAsIcon:=False)


'Redimensionnement de l'objet
LargeurMax = 750
ObjetLargeur = PowerObj.Width
ObjetHauteur = PowerObj.Height
MultiLargeur = LargeurMax / ObjetLargeur
MultiHauteur = HauteurMax / ObjetHauteur


If MultiLargeur < MultiHauteur Then
    Multi = MultiLargeur
Else
    Multi = MultiHauteur
End If


ObjetLargeur = ObjetLargeur * Multi 'agrandissement de l'objet
ObjetHauteur = ObjetHauteur * Multi


If MultiLargeur < MultiHauteur Then
    DecalageY = (HauteurMax - (ObjetHauteur + BordureY)) / 2
    NewTextBox.Top = NewTextBox.Top + DecalageY
Else
    DecalageX = (LargeurMax - (ObjetLargeur + BordureX)) / 2
    NewTextBox.Left = NewTextBox.Left + DecalageX
End If


PowerObj.Width = ObjetLargeur
PowerObj.Height = ObjetHauteur
NewTextBox.Width = ObjetLargeur + BordureX
NewTextBox.Height = ObjetHauteur + BordureY
NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text


 



'ins&#233;re plan ref dessous
WordFile.Range(Start:=11, End:=11).Select
Set NewTextBox = WordFile.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=35, Top:=72, Width:=30, Height:=30)
NewTextBox.TextFrame.TextRange.Select
Set PowerObj = WordObj.Selection.InlineShapes.AddOLEObject(ClassType:="PowerPCB.Design", Filename:=PowerObjNameRefDessous, LinkToFile:=False, DisplayAsIcon:=False)


'Redimensionnement de l'objet
LargeurMax = 750
ObjetLargeur = PowerObj.Width
ObjetHauteur = PowerObj.Height
MultiLargeur = LargeurMax / ObjetLargeur
MultiHauteur = HauteurMax / ObjetHauteur


If MultiLargeur < MultiHauteur Then
    Multi = MultiLargeur
Else
    Multi = MultiHauteur
End If


ObjetLargeur = ObjetLargeur * Multi 'agrandissement de l'objet
ObjetHauteur = ObjetHauteur * Multi


If MultiLargeur < MultiHauteur Then
    DecalageY = (HauteurMax - (ObjetHauteur + BordureY)) / 2
    NewTextBox.Top = NewTextBox.Top + DecalageY
Else
    DecalageX = (LargeurMax - (ObjetLargeur + BordureX)) / 2
    NewTextBox.Left = NewTextBox.Left + DecalageX
End If


PowerObj.Width = ObjetLargeur
PowerObj.Height = ObjetHauteur
NewTextBox.Width = ObjetLargeur + BordureX
NewTextBox.Height = ObjetHauteur + BordureY
NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text


 


            
'ins&#233;re plan valeur dessous
WordFile.Range(Start:=14, End:=14).Select
Set NewTextBox = WordFile.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=35, Top:=72, Width:=30, Height:=30)
NewTextBox.TextFrame.TextRange.Select
Set PowerObj = WordObj.Selection.InlineShapes.AddOLEObject(ClassType:="PowerPCB.Design", Filename:=PowerObjNameValDessous, LinkToFile:=False, DisplayAsIcon:=False)


'Redimensionnement de l'objet
LargeurMax = 750
ObjetLargeur = PowerObj.Width
ObjetHauteur = PowerObj.Height
MultiLargeur = LargeurMax / ObjetLargeur
MultiHauteur = HauteurMax / ObjetHauteur


If MultiLargeur < MultiHauteur Then
    Multi = MultiLargeur
Else
    Multi = MultiHauteur
End If


ObjetLargeur = ObjetLargeur * Multi 'agrandissement de l'objet
ObjetHauteur = ObjetHauteur * Multi


If MultiLargeur < MultiHauteur Then
    DecalageY = (HauteurMax - (ObjetHauteur + BordureY)) / 2
    NewTextBox.Top = NewTextBox.Top + DecalageY
Else
    DecalageX = (LargeurMax - (ObjetLargeur + BordureX)) / 2
    NewTextBox.Left = NewTextBox.Left + DecalageX
End If


PowerObj.Width = ObjetLargeur
PowerObj.Height = ObjetHauteur
NewTextBox.Width = ObjetLargeur + BordureX
NewTextBox.Height = ObjetHauteur + BordureY
NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text


 


 


NbLigne = 0
NbTable = 0


For Each aFeuille In ActiveWorkbook.Sheets


    If aFeuille.Name  "ERREUR" And aFeuille.Name  "Infos" Then
        
        aFeuille.Activate
        
        NbLigne = 1
        Do Until Cells(NbLigne, 2).Value = "" 'determine nombre de ligne de la feuille
            NbLigne = NbLigne + 1
        Loop
        NbLigne = NbLigne - 1
        
        Range(Cells(1, 1), Cells(NbLigne, 6)).Select
        Selection.Copy
        NbCellules = CompteNombreCellules(Selection)
        
        If aPage  Cells(1, 9).Value Then 'v&#233;rifie si le tableau est sur la m&#234;me page
        
            aPage = Cells(1, 9).Value
            NbTable = NbTable + 1
            
            If FirstPage  True Then
                WordFile.Paragraphs(1).Range.InsertBreak Type:=2  'saut de page
            Else
                FirstPage = False
            End If
            
            'WordFile.Paragraphs(1).Range.MoveUp Unit:=5, Count:=1 'selectionne la page pr&#233;c&#233;dente
            WordFile.Range(Start:=0, End:=0).Select
            
            Set NewTextBox = WordFile.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=28.5, Top:=72, Width:=775, Height:=390)
            
            NewTextBox.TextFrame.TextRange.PasteExcelTable False, False, False 'copie le tableau Excel dans Word


            Set aTable = NewTextBox.TextFrame.TextRange.Tables(1)
            aTable.Rows.HeightRule = 1
            aTable.Rows.Height = 0 'r&#233;duit la taille du tableau sous Word


            NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
            NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text


            'Set NewTextBox = Nothing
        
        Else
                
            Set aTable = NewTextBox.TextFrame.TextRange.Tables(1)
            aTable.Rows(1).Select
            WordObj.Selection.SplitTable
            NbTable = NbTable + 1
            
            WordObj.Selection.InsertParagraphBefore 'ins&#232;re une ligne vide
            WordObj.Selection.InsertParagraphBefore
            NewTextBox.TextFrame.TextRange.Paragraphs(1).Range.Select
            WordObj.Selection.PasteExcelTable False, False, False
            
            NewTextBox.TextFrame.TextRange.Paragraphs(NbCellules + NbLigne + 1).Range.Delete 'il faut d&#233;compter les cases fusionn&#233;es
                                    
            aTable.Rows.HeightRule = 1
            aTable.Rows.Height = 0 'r&#233;duit la taille du tableau sous Word
            
            NewTextBox.Fill.Visible = 0 'rend invisible le remplissage de la zone de text
            NewTextBox.Line.Visible = 0 'rend invisible les bordures de la zone de text
               
        End If
    End If
    
Next aFeuille
    
'WordObj.ScreenUpdating = True
Application.ScreenUpdating = True


WordObj.Visible = True


Set NewTextBox = Nothing
Set WordFile = Nothing
Set WordObj = Nothing


End Sub

WORD ET EXCEL

1 réponse

Discussions similaires