PowerPoint: Automatisch verlinkte Graphiken ändern
Betrifft: PowerPoint, Excel vba
Vba Code:
Alle verlinkte Grafiken in PowerPoint zu einer andern Excel-Mappe verschieben
Dieses Makro unter Microsoft MS PowerPoint ändert alle bisher verlinkten Bereiche zu einer Excel Datei unter PowerPoint zu einer anderen Excel Arbeitsmappe.
Option Explicit On
Public Sub Verknuepfung_Linked_Shapes_zu_Excel_aendern() '--------------------< Verknuepfung_Linked_Shapes_zu_Excel_aendern() >---------------- '*mit diesem Makro werden alle verlinkten Graphiken zu Excel-Dokumenten zu einem neuen Pfad erneuert '< setup > Dim sPfad As String sPfad = "C:\Users\poppr\Desktop\Analysedatei_FB_KER19.xlsm" '</ setup >
'< meldung > If vbYes <> MsgBox("Das Anbinden kann länger dauern.. " & vbCrLf & "Das Makro oeffnet gleich die ZielExcel-Datei und bindet die Folien an." & vbCrLf & "Soll gestartet werden ..", vbYesNo, "Soll die Anbindung gestartet werden?") Then Exit Sub End If '</ meldung >
'< Excel_oeffnen > '*erst Excel Ziel oeffnen Dim objExcel As Excel.Application Set objExcel = New Excel.Application objExcel.Workbooks.Open sPfad '</ Excel_oeffnen >
'< init > Dim objPPT As Presentation Set objPPT = ActivePresentation '</ init >
'--------< @Loop:Slides >-------- Dim objSlide As Slide For Each objSlide In objPPT.Slides '------< Slide >------ '------< @Loop: Shapes >------ Dim objShape As Shape For Each objShape In objSlide.Shapes '------< Shape >------ DoEvents '*
If objShape.Type = msoLinkedOLEObject Then '----< IsLinkedOLEObject >---- '< set_Link_manual > '*zur Sicherheit Link auf Manuell schalten 'manuelle Verknuepfung If Not objShape.LinkFormat.AutoUpdate = ppUpdateOptionManual Then objShape.LinkFormat.AutoUpdate = ppUpdateOptionManual End If '</ set_Link_manual >
'----< Check_Link_IsExcel >---- '*wie: Excel.SheetMacroEnabled.12 If InStr(objShape.OLEFormat.ProgID, "Excel.Sheet") > 0 Then '--< Link_IsExcel >-- Dim sLink As String sLink = objShape.LinkFormat.SourceFullName '*Link ist wie: C:\.....xxx.xlsm!ExcelBlatt!Z1S1:Z1:S1
If InStr(1, sLink, sPfad, vbTextCompare) < 1 Then '----< Link_ist_falsch >----
'< get pos_Excel > Dim pos_Excel As Integer pos_Excel = InStrRev(sLink, ".xls", -1, vbTextCompare) '</ get pos_Excel >
If pos_Excel > 0 Then '< get_pos_Area > Dim posArea As Integer posArea = InStr(pos_Excel, sLink, "!", vbBinaryCompare) '<( get_pos_Area >
'< get neuer Pfad > Dim sArea As String sArea = Mid(sLink, posArea)
Dim sLink_Neu As String sLink_Neu = sPfad & sArea '</ get neuer Pfad >
'< Link aendern > objShape.LinkFormat.SourceFullName = sLink_Neu '< Link aendern > End If '----</ Link_ist_falsch >---- End If '--</ Link_IsExcel >-- End If '----</ Check_Link_IsExcel >---- '----</ IsLinkedOLEObject >---- End If '------</ Shape >------ Next '------</ @Loop: Shapes >------ '------</ Slide >------ Next '--------</ @Loop:Slides >--------
'< Abschluss > objExcel.Quit '</ Abschluss >
MsgBox("Fertig!") '--------------------</ Verknuepfung_Linked_Shapes_zu_Excel_aendern() >---------------- End Sub
|
Dabei wird Excel als verlinkte Grafik eingebunden..
Wie bindet man in Excel einen Excel-Bereich als verlinkte Graphik ein?
Eine verlinkte Grafik hat zur Folge, dass sich die Grafik ändert, sobald der Bereich sich in der original-Excel Tabelle geändert hat und man auf Verlinkung aktivieren ausführt.
Einen Excel Bereich markieren
Auf PowerPoint wechseln und
Und dann->auf Menü->START->Einfügen ->Erweitert->Inhalte einfügen->VERLINKUNG einfügen->
Als Microsoft Excel-Arbeitsmappe-objekt (aber als verlinkte Grafik !!)