WORD ET EXCEL

raphexlilly Messages postés 17 Date d'inscription lundi 7 juin 2004 Statut Membre Dernière intervention 11 juin 2013 - 12 janv. 2005 à 11:08
cs_Emcy Messages postés 42 Date d'inscription mercredi 1 octobre 2003 Statut Membre Dernière intervention 17 juillet 2012 - 14 janv. 2005 à 16:09
J'ai un fichier word avec un macro qui ouvre un fichier excel le referme et produit un résultat dans word sans jamais "voir" excel. Mon problè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

1 réponse

cs_Emcy Messages postés 42 Date d'inscription mercredi 1 octobre 2003 Statut Membre Dernière intervention 17 juillet 2012
14 janv. 2005 à 16:09
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 à 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é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^é


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é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é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é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é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é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érifie si le tableau est sur la mê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écé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é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è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écompter les cases fusionnées

aTable.Rows.HeightRule = 1
aTable.Rows.Height = 0 'ré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
0