Gem som Billede - Makro

Kunne du fortælle hvad dit ønskede resultat i PowerPoint er.
Tror at du kan løse det hele fra PP, men jeg må vide lidt mere om hvilken opgave det er du skal løse

Det tror jeg ikke den kan. Jeg skal bruge nogle af funktionerne, der ligger i Excel for at danne et ordentligt diagram, der samtidig er dynamisk i opsætningen.

Hvad med at dele spørsmålet op i nogle stykker: F.eks. Hvordan åbner jeg PP og ser en ny præsentation. jeg kan godt få pp Åbnet men uden præsentation:

Sub StartPPS()

Dim oApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation

  Set oApp = CreateObject("PowerPoint.Application")
  oApp.Visible = True

'Set myPresentation = oApp.Presentations.open("Stien til dit show")
End Sub

Hvad mangler jeg?

så tror jeg du skal smide spm. over i ppt. gruppen ;o)

Sub Dias()
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
        xlPicture

' OpretDias
'
Dim PPApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim strFILNAVN As String
Dim strHDMAPPE As String

   
    Set PPApp = CreateObject("Powerpoint.Application")
    Set PPTPres = PPApp.Presentations.Add
    PPApp.Visible = True
    PPApp.ActiveWindow.ViewType = ppViewSlide
   
    With PPTPres.Slides
    Set PPTSlide = .Add(.Count + 1, ppLayoutText)
    End With
    Set PPTSlide = PPTPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)


    PPApp.ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
    PPApp.ActiveWindow.View.Paste
    PPApp.Activate
   
    gem = MsgBox("Skal dias gemmes", vbYesNo, "Skal dias gemmes")
    If gem = 6 Then
    strHDMAPPE = "C:\"
    strFILNAVN = InputBox("Gem Dias som:", "Gem Dias") & ".gif"
   
    PPApp.ActivePresentation.SaveAs Filename:=strHDMAPPE & strFILNAVN, FileFormat:=ppSaveAsGIF, EmbedTrueTypeFonts:=msoFalse
    'PPApp.ActivePresentation.SaveAs Filename:=strHDMAPPE & strFILNAVN & " " & strdato
    Else
    End If
   
   
    PPApp.ActivePresentation.Close
    Set PPTSlide = Nothing
    Set PPTPres = Nothing
    Set PPApp = Nothing

   
   
End Sub

Ups den gemmer i en nu mappe hvergang, med dias navn "dias1"... Kigger på det.

Denne virker sku, fundet via google.


Sub Create_GIF()

Dim mychart As Chart
Set mychart = ActiveChart
strHDMAPPE = "C:\"
strFILNAVN = InputBox("Navn på filen", "Gem som gif fil") & ".gif"
mychart.Export Filename:=strHDMAPPE & strFILNAVN, FilterName:="GIF"
     
End Sub

lerskov> tak, men får følgende fejl i sidste linje:
Object variable or With block variable not set

Hvad er galt?

Hvor skal tilretningen indsættes og hvaden ersattte?

Kan du prøve og beskrive hvad den gør som REM(')linjer?

Lerskov>jeg kan også se i makroen du lavede først, at det er diaset du gemmer - Det er KUN det diagram, der hentes over der skal gemmes!

Lerskov> hallo har du glemt mig :-)

Der er ingen grund til at hente noget over i PP.

Lerskovs

Sub Create_GIF()

Dim mychart As Chart
Set mychart = ActiveChart
strHDMAPPE = "C:\"
strFILNAVN = InputBox("Navn på filen", "Gem som gif fil") & ".gif"
mychart.Export Filename:=strHDMAPPE & strFILNAVN, FilterName:="GIF"
     
End Sub

virker på et markeret diagram direkte i Excel.

jkrons> jeg får en fejl, i sidste linje - se #7
Derudover så får jeg ikke mulighed for at vælge hvor filen skal gemmes - se start indlæg!

Jeg får ikke samme fejl nu - Jeg får at vide at export objekt fejler!

Prøv med

Sub Create_GIF()

Dim mychart As Chart
Set mychart = ActiveChart
StrFILTYPE = InputBox("Indtast filtype, gif eller jpg", "Filtype")
strHDMAPPE = InputBox("Indtast sti til filen", "Stinavn")
strFILNAVN = InputBox("Indtast navn på fil uden filtype.", "Filnavnl") & "." & StrFILTYPE
mychart.Export Filename:=strHDMAPPE & strFILNAVN, FilterName:=StrFILTYPE
     
End Sub

Ellers kan du hente et eksempel her,der giver mulighed for at gemme både som gif og jpg, men jeg får det først lagt op i morgen.

www.kronsell.net/ExcelEksempler.htm

Og det varede så kun til nu. Eksemplet er på plads på ovenstående link.

jkrons> Tak for det, men jeg får stadig en fejl i sidste linje:

mychart.Export Filename:=strHDMAPPE & strFILNAVN, FilterName:=StrFILTYPE

Den er stadig gal med Export - Jeg får følgende fejl Method 'Export' of object'_ Chart' falied.

Når jeg prøver din version får jeg følgende fejl:

Object required (Error 424) også i sidste linje - Mangler jeg noget i min version af excel? Jeg bruger 2003!

Din form er super - men kunne man indbygge en "gennemse" til at udpege stien?

Jeg kan ikke forestille mig, hvad du skulle mangle i Excel.

Hvad taster du helt konkret i inputboksene?

Omkring en "stifinder" ser jeg på det i morgen.

Jeg har lagt en ny version. Klik på knappen Søg sti for at udpege stien. Når du har den klikker du på Gem, hvorefter der returneres til formularen. Her kan du så udfylde resten.

Det er gået lidt hurtigt, så der er ingen indbygget fejlhåndtering, men det kommer nok i løbet af nogle dage. Fx giver den nu fejl, hvis du ikke har nmarkret et diagram, når du prøver at gemme, og der er også et par andre fejl, der kan opstå, hvis fx ikke alle felter er udfyldt eller udfyldt forkert.

jkrons>det virker :-)
smid et svar!

Ved du om man kan kopier former over i andet modul?

vil gerne have en makro, der tester for fejl :-)

Tak!

Her er st svar. Hvis du skal kunne bruge funktionen i andre mapper er det nemmeste at gemme den som tilføjelsesprogram og så tilføje dette til Excel. Så er funktionen tilgengælgelig i alle mapper.

Til dit konkrete spørgsmål kan man ikke kopiere en formular fra en mappe til en anden, men man kan gå en omvej.

I Objektbrowseren højreklikker du på formens navn. Vælg export file og gem den et fornuftigt sted. I den nye mappe vælger du file - Import File, og imporerer den netop gemte form file. Så importeres formen og den tilhørende kode.

Og det skulle så have været et svar,

Jeg giver lige besked, når jeg får en endelig version klar på hjemmesiden.

Så er den færdige version på plads. Nu med fejlhåndtering mm.

Tak!

jkrons> der er en lille fejl..

Når man ønsker at gennemse hvor man vil placere filen og fortryder ved at klikke på annuller, så får man en fejl i Commandbutten3():  filst = Mid(filna, 1, InStrRev(filna, "\") - 1)

Jeg tror ikke der er taget højde for det i vba'en!

Ønske: Jeg har en sti stående i Ark2: H3. Den vil jeg gerne have stående i Feltet STI, når man åbner GemDia - Hvordan gør jeg det?

Ønske: Når Gennemse åbnes, er der også mulighed for at skrive filnavn - Kan det komme ned i feltet Navn?

Problemet løses ved at tilføje linjen

On Error Resume Next i makroen, der åbner gem-boksen, og du har helt ret. Den variant havde jeg ikek taget højde for.

Private Sub CommandButton3_Click()
    On Error Resume Next
    filna = Application.GetSaveAsFilename( _
    fileFilter:="Grafikfiler (*.jpg), *jpg, Grafikfiler (*.gif), *gif")
    filst = Mid(filna, 1, InStrRev(filna, "\") - 1)
    Me!sti = filst
End Sub'

Dit ønske opfyldes hvis du ændrer koden i Userform_Activate til

Private Sub UserForm_Activate()
    combobox1.AddItem "gif"
    combobox1.AddItem "jpg"
    combobox1.Style = fmStyleDropDownList
    combobox1.BoundColumn = 0
    combobox1.ListIndex = 0
    sti = Sheets("Ark2").Range("h3").Value
End Sub

Hvis arket ikke hedder Ark2, skal du ændre til det reelle navn på arket, eller du kan skrive Sheets(2).Range("h3).value. Så henter den værdien fra H3 i det ark, der til enhver tid ligger nummer to.