AppActivate

Forumthread: AppActivate

AppActivate

16.06.2006 19:30:12

Armin

hallo,
ich stelle die frage noch mal rein, weil ich denke, die antwort ist ganz einfach, aber ich komm nicht drauf:
ich habe jetzt schon einiges gegoogelt, komme aber nicht weiter:


Private Sub CommandButton_ErgebnisseUploaden_Click()
Dim appid As Double
Const Auswertungsfile = "C:\Daten\Armin\Homepage\images\AWMAuswertung.gif"
ActiveSheet.Range("B1", ActiveSheet.Range("F1").End(xlToRight).End(xlDown)).Select
Selection.Copy
appid = Shell("mspaint.exe " & Auswertungsfile, 1)
'Sicherstellen dass mspaint den Fokus hat
AppActivate appid
SendKeys "%{INSERT}"
SendKeys "^S"
SendKeys "%{F4}"
End Sub

leider kommt bei appactivate immer ein laufzeitfehler 5. warum ist das so und wie mache ich das auf eine andere (richtige) art, in ein gif-file per mspaint die zwischenablage einzufügen?
danke für eure hilfe.
lg armin

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AppActivate - schon nachgestellt?

16.06.2006 21:23:04

Armin
AW: AppActivate - schon nachgestellt?

16.06.2006 21:45:57

Josef
Perfekt! aber noch was

17.06.2006 09:08:26

Armin
AW: Perfekt! aber noch was

17.06.2006 09:36:30

Josef
AW: Perfekt! aber noch was

17.06.2006 18:56:13

Armin

AppActivate - schon nachgestellt?

16.06.2006 21:23:04

Armin

hallo,
kann es sein, dass das wirklich so schwierig ist? kann mir bitte jemand vielleicht einen tipp geben, wie ich das sonst lösen kann?
danke und schönen abend
armin

AW: AppActivate - schon nachgestellt?

16.06.2006 21:45:57

Josef

Hallo Armin!
Schwierig ist es nicht, aber es war schwer deine Angaben zu interpretieren.
Du willst also einen Tabellenbereich als "gif" abspeichern.
Dann probier's mal so

Private Sub CommandButton_ErgebnisseUploaden_Click()
Dim objPict As Object
Dim MyChart As Chart

Const Auswertungsfile = "C:\Daten\Armin\Homepage\images\AWMAuswertung.gif"

ActiveSheet.Range("B1", ActiveSheet.Range("F1").End(xlToRight).End(xlDown)). _
  CopyPicture Appearance:=xlScreen, Format:=xlBitmap

ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

Set objPict = Selection

With objPict
  .Copy
  Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width + 8, .Height + 8).Chart
End With

With MyChart
  .Paste
  .Export Auswertungsfile
  .Parent.Delete
  objPict.Delete
End With

End Sub

Gruß Sepp

Perfekt! aber noch was

17.06.2006 09:08:26

Armin

wirklich perfekt, da hätte ich lange googeln können. ausserdem hab ich jetzt endlich das mit den objects kapiert, danke!!!
frage noch. wozu "+ 8"? bekomme ich irgendwie den rand rundherum weg, möchte EXAKT nur die zellen haben?
und etwas völlig anderes: wie bringe ich nach einem selection.copy den markierungsrand wieder weg?
lg armin

AW: Perfekt! aber noch was

17.06.2006 09:36:30

Josef

Hallo Armin!
So geht's ohne Rand.

Private Sub CommandButton_ErgebnisseUploaden_Click()
Dim objPict As Object
Dim MyChart As Chart

Const Auswertungsfile = "C:\Daten\Armin\Homepage\images\AWMAuswertung.gif"

ActiveSheet.Range("B1", ActiveSheet.Range("F1").End(xlToRight).End(xlDown)). _
  CopyPicture Appearance:=xlScreen, Format:=xlBitmap

ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

Set objPict = Selection

With objPict
  .Copy
  Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
End With

With MyChart
  .ChartArea.Border.Weight = 1
  .ChartArea.Border.LineStyle = 0
  .Paste
  .Export Auswertungsfile
  .Parent.Delete
End With

objPict.Delete

Set objPict = Nothing
Set MyChart = Nothing

End Sub

Nach ".Copy" kannst du mit "Application.CutCopyMode = False" den Markierungsrand aufheben.

Gruß Sepp

AW: Perfekt! aber noch was

17.06.2006 18:56:13

Armin

Danke, wirklich toll!
lg armin

Beliebteste Forumthreads (12 Monate)

Forumthread: AppActivate

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread