02. oktober 2011 - 13:09Der er
3 kommentarer og 1 løsning
Ændring af kilde mellem PowerPoint og Excel
Hej,
Jeg har nu lavet en template præsentation, som indeholder en lang række kæder til et dertilhørende Excel ark. Herved kan jeg let bearbejde data fra Excel og lade informationerne fremgå pænt af præsentationen.
Mit problem er dog at jeg ønsker at kopiere disse to filer (Powerpoint og Excel) således at jeg kan anvende disse templates på en lang række opgaver. Det vil sige at jeg ønsker at anvende "sættet" flere forskellige steder på mine drev.
Min Powerpoint peget naturligvis tilbage til den oprindelige Excel kildefil, hvilket jeg godt kunne tænke mig at ændre på. Jeg har så mange kæder, at det vil være for besværligt at ændre dem én efter én i PowerPoint.
Jeg tænker derfor om der er nogen har et bud på hvordan man kan gøre det smartere!
Kan man ændre tilgangen, således at den ikke peger på den eksakte sti, men på en fil med et given navn i samme mappe (a la ..\Data.xlsx) eller kan man lave en kodestump, som ændrer kilden automatisk for de respektive kæder).
På forhånd tusind tak!
Med venlig hilsen Christian
================================================= Både Excel og Powerpoint er 2010 versionen
De fleste virksomheder har efterhånden bevist, at AI virker.
Pilotprojekter leverer resultater. Medarbejdere bruger generative AI-værktøjer. Nye use cases dukker op på tværs af organisationen.
Koden indsættes i Regnearksfilen: Aktuelle navn på PP-filen tilpasses
Public pp As Object, systemSti As String Public Sub opdaterKædeTilPP() systemSti = ActiveWorkbook.Path + "\"
Set pp = CreateObject("PowerPoint.Application") With pp .Visible = True .Presentations.Open Filename:=systemSti & "Test eksempel.pptx", ReadOnly:=msoFalse '<------------- aktuelle filnavn // PP End With
tilpasKæder
pp.ActivePresentation.SlideShowSettings.Run End Sub Private Sub tilpasKæder() Dim ptSti As String, ptFilNavn As String Dim oprKæde As String, glStart As String Dim nyKæde As String ptSti = ActiveWorkbook.Path ptFilNavn = ActiveWorkbook.Name
If Right(ptSti, 1) <> "\" Then ptSti = ptSti & "\" End If
With ThisWorkbook.pp antalSlides = .ActivePresentation.Slides.Count
For Each sld In .ActivePresentation.Slides For Each sh In sld.Shapes If sh.Type = msoLinkedOLEObject Then oprKæde = sh.LinkFormat.SourceFullName p = InStr(oprKæde, "!") If p > 0 Then glStart = Left(oprKæde, p - 1) nyKæde = ptSti & Replace(oprKæde, glStart, ptFilNavn) Else Stop End If
sh.LinkFormat.SourceFullName = nyKæde
End If Next Next End With
opdaterDias
Rem Gem pp-filen ThisWorkbook.pp.ActivePresentation.Save End Sub Private Sub opdaterDias() On Error Resume Next Application.ScreenUpdating = False
With ThisWorkbook.pp For Each sld In .ActivePresentation.Slides For Each sh In sld.Shapes If sh.Type = msoLinkedOLEObject Then sh.LinkFormat.Update End If Next Next End With
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
