Macro copy/send qui fonctionnait sur XP et plus sur Windows 7

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Macro copy/send qui fonctionnait sur XP et plus sur Windows 7

Coellophysis

Bonjour à tous,

Voilà, pour le travail, j'avais une macro qui copiait un tableau et l'envoyait via Outlook mais depuis que j'ai migré de XP à Wds 7, elle fonctionne plus. Le bug arrive au moment où le tableau doit être copié. Je reçois un message plutôt général comme "method or data member not found".

J'ai essayé de chercher des pistes sur le net mais je ne trouve pas, je vous remercie pour votre aide.

Apparemment il y a des balises C/C pour les codes mais honnêtement, je ne comprends pas de quoi il s'agit, si vous m'expliquez, je modifierai le codes dans le format désiré.

Voici le code:

Code :

Option Explicit
Sub CreateEmail()
'create picture files
Dim rng As Range
Dim strFolder As String
strFolder = ActiveWorkbook.path & "\"
Set rng = Sheet5.Range("v_report" )
If Not ExportRangeToPicture(rng, strFolder & "profile_vol.png" ) Then
MsgBox "Error while creating png files"
GoTo ExitProc
End If
'prepare email
Dim strHTML As String
Dim myOlApp As Variant, myItem As Variant, olMailItem As Variant
Set myOlApp = CreateObject("Outlook.Application" )
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.Subject = Sheet5.Range("em_subject" ).Value
myItem.To = Sheet5.Range("em_to" ).Value
myItem.CC = Sheet5.Range("em_cc" ).Value
'myItem.Importance = Outlook.OlImportance.olImportanceLow
myItem.Attachments.Add strFolder & "profile_vol.png"
strHTML = "<html><img src='profile_vol.png'><br><br>"
strHTML = strHTML + "</html>"
myItem.HTMLBody = strHTML
myItem.Display
ExitProc:
End Sub
Function ExportRangeToPicture(rng As Excel.Range, img As String) As Boolean
' save a range from Excel as a picture
' rng = Range to export
' img = filename & path
' basic error checking
' check for valid filetypes
' from http://peltiertech.com/WordPress/e [...] mage-file/
'Const FILE_EXT As String = "gif,png,jpg,jpe,jpeg"
'If InStr(FILE_EXT, LCase$(Right$(img, 3))) = 0 Then
'GoTo ExitProc
'End If
' check for valid path
'Dim path As String
'path = Left(img, InStrRev(img, "\" ))
'If Dir(path, vbDirectory) = "" Then GoTo ExitProc
' check for valid range
Dim rRng As Range
On Error Resume Next
Set rRng = rng
On Error GoTo 0
If rRng Is Nothing Then GoTo ExitProc
' check for protected worksheet
If ActiveSheet.ProtectContents Then GoTo ExitProc
' copy range to picture, put into chart, export it
'Application.ScreenUpdating = False
rRng.CopyPicture xlScreen, xlBitmap
Dim cht As ChartObject
Set cht = Sheet1.ChartObjects.Add(0, 0, rRng.Width + 1, rRng.Height + 1)
With cht
.Chart.ChartArea.Border.LineStyle = xlLineStyleNone
.Chart.PasteSpecial.xlPasteValues
.Chart.Export img, Filtername:="png"
.Delete
End With
' if we got this far, assume success
ExportRangeToPicture = True
ExitProc:
'Application.ScreenUpdating = True
Set cht = Nothing
Set rRng = Nothing
End Function

Bien à vous

Message édité par Coellophysis le 19-07-2016 à 09:40:35

Publicité

Chelmi18

Salut,

Les balises [ cpp ][ /cpp ] s'utilisent très simplement : Tu mets ton code entre les deux et c'est tout.

Exemple : [ cpp ]Toto[ /cpp ] affichera

Code :

Toto

Sinon, pour ton problème qu'appelle-tu le moment où le tableau doit être copié ?
C'est l'instruction rRng.CopyPicture xlScreen, xlBitmap qui plante ?

Si oui, est-ce que ca marche en pas à pas (Débogage puis F8) ?

Coellophysis

Bonjour Chelmi18,

Je te remercie pour ton explication cpp /cpp, j'ai pu édité le message.

Pour le code, non il ne fonctionne pas étape par étape via le F8, lors du bug, la surbrillance se trouve ici ".Chart.PasteSpecial.xlPasteValues"

Bien à toi.

Chelmi18

Je ne comprends pas bien ce que tu cherches à faire : un objet Chart est un graphique pas une image.
Je ne suis donc pas sûr que tu puisses agir sur un graphique avec l'instruction .PasteSpecial.xlPasteValues.

Si tu cherches juste à sauvegarder un graphique déjà existant en tant qu'image, tu peux essayer en enlevant cette instruction je pense.
Sinon, essaye en passant plutôt par un objet de type Shape qui sera plus approprié à mon avis.

Coellophysis

Mon but est de copier un chart vers un email, cette méthode a fonctionné pendant 2 ans jusqu'à je migre vers Windows 7.

Chelmi18

Dans ce cas, remplace la ligne 80

Code :

.Chart.PasteSpecial.xlPasteValues

par

Code :

.Chart.Paste

Coellophysis

Bonjour,

Ca n'a pas fonctionné mais c'était bien tenté.

Chelmi18

C'est curieux, cela a fonctionné nickel chez moi ?!

J'avais bien une image de mon range dans le mail (Windows 7, Excel 2010).

Ça fait quoi chez toi ? même erreur ?

Coellophysis

Voici ce que je reçois comme message d'erreur:

Run time error '1004': Method Paste of Object_Chart failed

bien à toi

Chelmi18

Apparemment, ce problème semble se produire si la copy n'a pas fonctionné comme prévue, par exemple si le Range copié déborde de la partie visible de l'écran.
Est-ce ton cas ?

Si oui, regarde la solution expliquée là : http://stackoverflow.com/questions [...] creen-area
Notamment la partie ZoomToRange.

Hope this helps.

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Macro copy/send qui fonctionnait sur XP et plus sur Windows 7

Sujets relatifs
piloter la fenetre windows en vba	macro
[VB/VBA/VBS] Macro excel d’impression sur plusieurs feuilles.	Macro générer fichier excel avec info dans l'ordre
Script windows, help please	macro impression excel sous condition
Macro excel - décocher toutes les cases d'un filtre sauf une	Macro Excel - Importation fichier htm
Macro Exel
Plus de sujets relatifs à : Macro copy/send qui fonctionnait sur XP et plus sur Windows 7

Page générée en 0.069 secondes