raphexlilly
Messages postés17Date d'inscriptionlundi 7 juin 2004StatutMembreDernière intervention11 juin 2013
-
12 janv. 2005 à 11:08
cs_Emcy
Messages postés41Date d'inscriptionmercredi 1 octobre 2003StatutMembreDernière intervention17 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
cs_Emcy
Messages postés41Date d'inscriptionmercredi 1 octobre 2003StatutMembreDernière intervention17 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
'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
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)
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)
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)
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
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
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