Arbejd fra Excel med Makro i mspaint

Her er et forsøg. Jeg kan få det til at virke, men det er i en engelsk version.
Kør IKKE denne makro omme fra VBA-editoren.

Sub Billedfil()
    On Error GoTo Problem
    Range("B2:J36").Select
    Selection.Copy
    Appx = "C:\WINDOWS\System32\mspaint.exe"
    ID = Shell(Appx, 1)
    Application.Wait (Now + TimeValue("0:00:02"))
    SendKeys "^v"
    SendKeys "^s"
    SendKeys [H11].Text
    SendKeys "{TAB}"
    SendKeys "T"
    SendKeys "%s"
    SendKeys "%{F4}"

    ' Jeg vil gerne hvis man fra kode Excel kan sætte ind *
    ' i mspaint (V+Ctrl)                                  *
    ' samt gemme filen som TIF fil  C\: med det navn som *
    ' står i H11 ER det muligt.                          *
    '******************************************************
    Range("H12").Select
    Exit Sub
Problem:
    MsgBox Appx & "kan ikke åbnes"
End Sub

Juster evt på WAIT tiden. Jeg er ikke helt sikker på at den er nødvendig, men paint skal lige have tid til at åbne
SendKeys "%{F4}"  lukker paint igen

Jeg kan ikke få det til at virke, når den sender SendKeys "^s" prøver den at sende tilbage til en fil der endnu ikke er gemt, det kan den ikke, den gemmer en tom fil.
Jeg tror man skal starte en eksisterende fil i mspant fx C:\skabilon.TIF, men jeg ved bare ikke hvordan.

Jeg kan se at der er noget forskel på min arbejdsmaskine og min comp. hjemme

Sub Billedfil()
    On Error GoTo Problem
    Range("B2:J36").Select
    Selection.Copy
    Appx = "C:\WINDOWS\System32\mspaint.exe"
    ID = Shell(Appx, 1)
    Application.OnTime Now + TimeValue("00:00:01"), "Sendtaster"
 
    Range("H12").Select
    Exit Sub
Problem:
    MsgBox Appx & "kan ikke åbnes"
End Sub

Sub sendtaster()
    SendKeys "%rn"
    SendKeys "%fm"
    SendKeys [H11].Text
    SendKeys "{TAB}"
    SendKeys "T"
    SendKeys "%G"
    SendKeys "%s"
    SendKeys "%{F4}"
End Sub

et alternativ uden mspaint, ren excel....

Sub ScreenShot()
Dim wks As Worksheet
Dim cht As Chart
Dim stName As String
Application.ScreenUpdating = False
Range("IE1").Select

Set wks = ActiveSheet
stName = [H11].Text
wks.Range("B2:J36").CopyPicture Appearance:=xlScreen, _
  Format:=xlPicture
Set cht = Charts.Add
With cht
  On Error Resume Next
  .Paste
  On Error GoTo 0
End With
cht.Export "c:\" & stName & ".tif", FilterName:="TIF"

Application.DisplayAlerts = False
cht.Delete
Range("H12").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Undskyld den lange svartid, jeg var ikke hjemmer.
Jeg kan ikke få det til at virke, koden stopper ved linjen,
cht.Export "D:\" & stName & ".tif", FilterName:="TIF"
Jag har smidt koden ind i et Modul,
jeg har prøvet at skrive i H11 D:\
samt prøvet at skrive i H11 D:\2748
jeg har også prøvet at ligge en fil som heder 2748.Tif på D roden

den opretter godt nok et diagram, men den exporterer det ikke som en TIF fil til D roden?

i H11 skal du kun skrive filnavnet, ikke andet. Kun 2748.

Send mig lige en mail, så sender jeg et eksempel tilbage. excel snabela tbdl.dk
Hvis det ikke fungerer, så skal vi nok have fat i din installation.
Måske hat du ikke installeret driver til TIF.
Du kunne evt. prøve at lave en gif eller en jpg-fil istedet
cht.Export "D:\" & stName & ".gif", FilterName:="GIF"
cht.Export "D:\" & stName & ".jpg", FilterName:="JPG"

jens@fagpolering.dk i gif virker det

Hvordan instalerer man driver til TIF?

Jeg mener at man i selve office-installationen har mulighed for at installerede diverse grafik-konverterer.

Ok hvis du smider et svar får du dine point, du har så rigelig fortjent dem tusind tak

ok, og fortsat god jul :-)

I lige måde.