Macro qui ne marche plus !! Erreur sur une ligne ?

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Bonjour

est normal l'espace dans "PasteSpeci al"?

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Bonjour Malka

A ma connaissance Pastecial n'a pas de parametre DataType

Je te suggere d'executer le type de collage special que tu souhaites avec un enregistrement de macro
La lecture de cette macro te permettra de definir les parametres de ton Pastespecial

Bon courage

Arf !!! en relisant je m'apercois qu'il s'agit de WORD et non d' EXCEL
Dans Word effectivement ce DataType existe
La methode pourra peut etre quand même s'averer utile

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Salut à toutes et tous,

Je sens que je vais exploser !!! 😡

Je ne comprends rien ! de rien !
Ma macro marche sur le portable où j'ai programmé initialement cette macro.
J'ai changé de portable et puis la macro bloque sur cette ligne de m...de !

Meme quand je mets
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteBitmap, Placement:=wdInLine

Ca m'envoit un tableau où je peux manupuler les données ! alors que sur un autre portable j'ai bien une image bimap.
Je ne comprends rien !!! AIDEZ MOI !!!! 😱

La meme ligne de code plus loin, ca me mets bien une image bitmap mais pas à la premiere ligne de collage du tableau.??????

Ca peut venir de word ??? mais pourquoi ca marche les 3 ou 4 collages suivant mais pas le premier ???

Mon code en entier :

Dim wdApp As New Word.Application

Dim wdDoc As Word.Document


Public Sub Edition()


ActiveWorkbook.CustomViews("ElementsPnL").Show


ActiveSheet.Range("C1:BR1099").Copy


Set wdDoc = wdApp.Documents.Open("C:\Users\Malka\Desktop\Maquette arbitrage\AbitrageTest.doc")


wdApp.Visible = True



'Envoie des elements principaux du P&L
wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="PnL" 'recherche du signet
End With

'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4

'With wdApp.Selection
'.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
'End With


wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteBitmap

Application.CutCopyMode = False


'Envoie des elements EBITDA
wdDoc.Activate

wdDoc.Bookmarks("EBITDA1").Range.Text = Cells(1107, 79).Text
wdDoc.Bookmarks("EBITDA2").Range.Text = Cells(1108, 79).Text
wdDoc.Bookmarks("EBITDA3").Range.Text = Cells(1109, 79).Text
wdDoc.Bookmarks("EBITDA4").Range.Text = Cells(1110, 79).Text

'Envoie des elements Consomations Intermédiares
wdDoc.Activate

wdDoc.Bookmarks("ConsoInterm1").Range.Text = Cells(1114, 79).Text
wdDoc.Bookmarks("ConsoInterm2").Range.Text = Cells(1115, 79).Text
wdDoc.Bookmarks("ConsoInterm3").Range.Text = Cells(1116, 79).Text
wdDoc.Bookmarks("ConsoInterm4").Range.Text = Cells(1117, 79).Text

'Envoie du nom de l'UO
wdDoc.Bookmarks("UO").Range.Text = Cells(1105, 78)





'Envoie des graphiques
ActiveWorkbook.CustomViews("Tout").Show

ActiveSheet.ChartObjects("Graphique 67").Activate
ActiveChart.PlotArea.Left = 1
ActiveChart.PlotArea.Top = 12
ActiveChart.PlotArea.Width = 270
ActiveChart.PlotArea.Height = 168
ActiveChart.Legend.Position = xlBottom


ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy

wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="Graph1" 'recherche du signet
End With

'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Application.CutCopyMode = False

ActiveSheet.ChartObjects("Graphique 68").Activate
ActiveChart.PlotArea.Left = 1
ActiveChart.PlotArea.Top = 12
ActiveChart.PlotArea.Width = 270
ActiveChart.PlotArea.Height = 168
ActiveChart.Legend.Position = xlBottom

ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy


wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="Graph2" 'recherche du signet
End With

'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Application.CutCopyMode = False

ActiveSheet.ChartObjects("Graphique 86").Activate
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = Range("CG1123").Value 'Attribution d'une valeur minimale de l'axe des Y
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

ActiveChart.PlotArea.Left = 1
ActiveChart.PlotArea.Top = 27
ActiveChart.PlotArea.Width = 690
ActiveChart.PlotArea.Height = 267

ActiveChart.Axes(xlCategory).TickLabels.Font.size = 6


With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = False
End With


ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy

wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="Graph3" 'recherche du signet
End With

'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Application.CutCopyMode = False

'Envoie des elements P&L arbitrés
ActiveWorkbook.CustomViews("ElementsArbitrés").Show
ActiveSheet.Rows(10).Select
Selection.AutoFilter Field:=48, Criteria1:="<8"
Range("A1:BM1033").Select
Selection.CopyPicture
ActiveSheet.Rows(10).Select
Selection.AutoFilter Field:=48
ActiveWorkbook.CustomViews("Tout").Show

wdApp.Visible = True
wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="ElementsArbitrages" 'recherche du signet
End With
'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Application.CutCopyMode = False




Set wdApp = Nothing
Set wdDoc = Nothing



'wdDoc.Close False
'wdApp.Quit


End Sub

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Bonjour Malka


Pitié pour nos yeux, stp 😉

Je te conseille d'utiliser ce que tu liras dans dans ma signature

ou à défaut ce bouton :

Merci pour eux

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Ok tu as raison, y a trop de données et ca doit faire mal au yeux à tout le monden🙄

En gros, ca deconne à la ligne rouge mais ca marche à la ligne verte
A la ligne rouge, le code passe mais le resultat sur word, je n'ai pas une image "fixée" où normalement je ne pas touchais aux chiffres.
Quand je remplace la ligne rouge par la verte ca bloque tout de suite cette fameuse ligne



Une copie du code avec les trucs inutile à mon pb en moins :

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document


Public Sub Edition()
ActiveWorkbook.CustomViews("ElementsPnL").Show
ActiveSheet.Range("C1:BR1099").Copy
Set wdDoc = wdApp.Documents.Open("C:\Users\Malka\Desktop\Maque tte arbitrage\AbitrageTest.doc")
wdApp.Visible = True



'Envoie des elements principaux du P&L
wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory
.Selection.Goto What:=wdGoToBookmark, Name:="PnL"
End With

wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteBitmap

Application.CutCopyMode = False


'Envoie des elements P&L arbitrés
ActiveWorkbook.CustomViews("ElementsArbitrés").Show
ActiveSheet.Rows(10).Select
Selection.AutoFilter Field:=48, Criteria1:="<8"
Range("A1:BM1033").Select
Selection.CopyPicture
ActiveSheet.Rows(10).Select
Selection.AutoFilter Field:=48
ActiveWorkbook.CustomViews("Tout").Show

wdApp.Visible = True
wdDoc.Activate

With wdApp
.Selection.HomeKey Unit:=wdStory 'envoie en début de page
.Selection.Goto What:=wdGoToBookmark, Name:="ElementsArbitrages" 'recherche du signet
End With
'wdApp.Selection.MoveUp Unit:=wdLine, Count:=4
wdDoc.ActiveWindow.ActivePane.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Application.CutCopyMode = False

Set wdApp = Nothing
Set wdDoc = Nothing

'wdDoc.Close False
'wdApp.Quit

End Sub

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Re


Je parlais juste d'utiliser les balises BBCODE quand tu insères du code VBA dans tes messages sur XLD, comme ma signature le rappelle amicalement 🙄

Sub Macro()
Ligne de code
Ligne de code
End Sub

La même chose avec les balises BBCODE

C'est mieux pour les yeux non ?

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Ok j'avais mal compris...
Je la refais :



C'est vrai que c'est plus cool à lire

PITIEZ ! AIDEZ MOI !!! 🙁

Malka

Re : Macro qui ne marche plus !! Erreur sur une ligne ?

Re

Merci pour le confort visuel.

Pour ta peine, je vais voir de plus près ton code 😉

EDITION:

Ma macro marche sur le portable où j'ai programmé initialement cette macro.
J'ai changé de portable et puis la macro bloque sur cette ligne de m...de !

Cliquez pour agrandir...

Les noms des chemins et des lettres de lecteurs sont bien identiques sur les 2 pc ?

PS: Quand tu auras le temps, penses à également éditer tes autres messages de ce fil contenants du code VBA.