VBA export Excel vers image sous MSPAINT

Lanic · 14 Octobre 2011

Bonjour,

Sous Excel 2007, je souhaite automatiser le capture d'une plage de cellules, exporter une copie de cette sélection vers MSPAINT, la coller et enregistrer l'image en .png.

Voici le code que j'utilise :
Sub EditPics()
Range("A1:AD23").Select
Selection.Copy
TheEditor = "C:\WINDOWS\system32\mspaint.exe"
TaskId = Shell(TheEditor, 1)
Application.SendKeys "^{V}", True
Application.SendKeys "^{S}", True
End Sub

La capture fonctionne bien, la copie aussi, le lancement de MSPaint aussi, puis plus rien, aucune image ne se colle ni ne s'enregistre....
Avez-vous une idée du pourquoi du comment ? une histoire de temporisation...?

Merci par avance.
Lanic.

Dranreb · 14 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Bonsoir.
J'utilise cette procédure dans un programme en VB6 pour communiquer une couleur courante à Paint:

VB:

Private Static Sub BtPaint_Click()
Const PgmPaint = "C:\WINDOWS\System32\MSPaint"
Dim PaintId As Variant, Z As String, Top As Long, Problème As String
Caption = "Couleurs - Transmettre à Paint"
Z = ""
Do:
   If IsEmpty(PaintId) Then
      PaintId = InputBox(Z & "Entrez le titre exact d'une fenêtre Paint existante," _
         & vbLf & "sinon Couleurs va tenter de lancer :" & vbLf & """" & PgmPaint & """.", _
         Caption, "Sans titre - Paint"): Z = ""
      If PaintId = "" Then
         On Error Resume Next: PaintId = Shell(PgmPaint, 1): Problème = Err.Description: On Error GoTo 0
         If Problème <> "" Then
            MsgBox "Shell """ & PgmPaint & """: " & Problème & vbLf _
               & "Veuillez lancer Paint par vous-même.", vbCritical, Caption
            PaintId = Empty: GoTo Épilogue: End If
'         MsgBox Z & "MSPaint N°" & PaintId & " lancé…" & vbLf & "Bon pour transmission comme" & _
'            vbLf & "couleur personnalisée courante…", vbInformation, Caption
         Z = "MSPaint N°" & PaintId & " lancé…": End If: End If
   Top = GetTickCount
   While GetTickCount < Top + 1000: DoEvents
      On Error Resume Next: AppActivate PaintId, Wait:=False: Problème = Err.Description: On Error GoTo 0
      If Problème = "" Then Exit Do
      Wend
   If TypeName(PaintId) = "String" Then Z = "Fenêtre """ & PaintId & """" Else Z = "MSPaint N°" & PaintId
   Z = Z & " introuvable." & vbLf: PaintId = Empty
   Loop
SendKeys "%CM%D%R" & TR.Text & "%V" & TV.Text & "%B" & TB.Text & "~", Wait:=True
'If Z <> "" Then MsgBox Z, vbInformation, Caption
Épilogue: Caption = "Couleurs"
End Sub

Ce qui est à en retenir:

AppActivate, instruction

Active une fenêtre d'application.
Syntaxe
AppActivate title[, wait]
La syntaxe de l'instruction AppActivate comprend les arguments nommés suivants :
ÉlémentDescriptiontitleExpression de chaîne indiquant le titre dans la barre de titre de la fenêtre d'application à activer. Pour activer une application, vous pouvez utiliser l'identificateur de tâche renvoyé par la fonction Shell à la place de l'argument title.waitFacultatif. Valeur de type Boolean qui indique si l'application appelante est active avant d'en activer une autre. Si la valeur est False (valeur par défaut), l'application indiquée est immédiatement activée, même si l'application appelante n'est pas active. Si la valeur est True, l'application appelante attend de devenir active, puis active l'application indiquée.

Remarques
L'instruction AppActivate rend active l'application ou la fenêtre nommée, mais ne l'agrandit ni ne la réduit. La fenêtre d'application cesse d'être active dès que l'utilisateur exécute une action qui entraîne la fermeture de la fenêtre ou l'activation d'une autre. Utilisez la fonction Shell pour démarrer une application et définir le style de la fenêtre.
Pour rechercher l'application à activer, les chaînes de titre de toutes les applications sont comparées avec celle de l'argument title. Si aucun titre ne correspond exactement à l'argument, une application dont le titre commence par la valeur de l'argument title est activée. Si plusieurs applications ont pour nom l'argument title, l'une d'entre elles est activée arbitrairement.

À +

Lanic · 14 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Bonjour Dranreb,
Merci pour la réponse.
Bon, étant débutant en VBA, là je suis perdu !
N'y a-t-il pas moyen de "simplement" corriger ce qui dysfonctionne dans mon script ?!

Lanic.

Compte Supprimé 979 · 14 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Bonsoir Lanic,

N'y a-t-il pas moyen de "simplement" corriger ce qui dysfonctionne dans mon script ?!

Simplement, NON, désolé pour toi

Il suffit de copier/coller le code de notre ami Dranreb en remplacement du tiens

A+

Dranreb · 15 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Heu, Lanic, j'espérais plutôt que tu capterait le message sous-jascent: il ne suffit pas de lancer une application pour qu'elle soit prête à traiter des SendKeys. Encore faut-il l'activer. Contrairement à ce que dit gentiment pour moi Bruno, il te manquerait l'implantation de GetTickCount pour que ça puisse tourner tel quel chez toi. Oh et puis pour y remédier il suffit d'ajouter ceci en tête du module:

VB:

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Donne le nombre de millisecondes écoulées depuis le lancement de windows.
Le but: AppActivate peut engendrer une erreur s'il est lancé trop tot après le Shell. Alors il faut boucler dessus jusqu'à ce qu'il n'en provoque plus ou jusqu'à une durée arbitraire au delà de laquelle on estime qu'il ne s'est pas bien lancé en fait. Au bout d'1 seconde dans mon exemple (1000 millisecondes)

Lanic · 16 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Bonsoir,
Merci pour vos réponses. J'avais oublié de vous dire que je débute en la matière...
Mais j'avais aussi identifié ce problème de "temporisation"... que j'ai corrigé de la sorte :

Sub paintum()
Range("A1:AD23").Select
Selection.Copy
ReturnValue = Shell("C:\WINDOWS\system32\mspaint.exe", 3)
Application.Wait Now + TimeValue("00:00:01")
SendKeys " ", True
SendKeys "^v", True
SendKeys "^s", True
SendKeys "%e", True
DoEvents
Application.Wait Now + TimeValue("00:00:01")
SendKeys "%{F4}", True 'Close MS Paint
DoEvents

End Sub

...et tout fonctionne !

Encore merci quand même.
Lanic.

Dranreb · 17 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Etonnant que ça marche sans AppActivate. Après un délai d'une seconde aussi... Alors qu'en bouclant sur AppActivate jusqu'à ce qu'il ne plante plus c'est quasi immédiat.

TempusFugit · 17 Octobre 2011

Re : VBA export Excel vers image sous MSPAINT

Bonjour

On peut aussi ne pas passer par MSPAINT pour exporter une plage de cellules en tant qu'image.

Testé sur Excel 2003

Code:

Sub ExportVersPNG()
Dim Plg As Range
Dim Gfx As Chart
Dim Img As Picture
Application.ScreenUpdating = False
Set Plg = Selection
Set Gfx = Charts.Add
Plg.CopyPicture xlScreen, xlPicture
With Gfx
    .Paste
    .Export Filename:="C:\Image01.png", Filtername:="PNG"
Application.DisplayAlerts = False
    .Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

VBA export Excel vers image sous MSPAINT

Lanic

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Lanic

XLDnaute Nouveau

Compte Supprimé 979

Guest

Dranreb

XLDnaute Barbatruc

Lanic

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

TempusFugit

XLDnaute Impliqué

Discussions similaires