Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

Excel vba Code zum Tauschen von Excel Pfaden in Verknüpfungen

14.02.2019 (­čĹü142)

Excel vba Addin-Code zum Tauschen von Excel Pfaden in Verkn├╝pfungen


Das folgende vba Makro tauscht alle Verkn├╝pfungen in einer Excel Datei zu einem neuen Pfad.

Dabei ist das makro zus├Ątzlich als Excel Addin geschrieben, wodurch man die Datei einfach ├Âffnen muss und die Datei dann als Men├╝->Addin->addin zur Verf├╝gung steht in jeder Excel Datei

Vba Makro Code

Folgend der reine vba Makro Code zum Tauschen der Excel Links.

Dabei werden in diesem Fall direkt die Excel LinkSources ge├Ąndert.

In Excel sind Workbook.LinkSources direkt  die internen Verkn├╝pfungen, welche von Zellen oder Names-Bez├╝gen und auch von Graphiken und eingebetteten OLE Objekten aus gehen.

Vba Code in Excel

Vba Macro Code

Option Explicit

Public Sub fx_Pfade_austauschen()

    '----------------< fx_Pfade_austauschen() >----------------

   

    '< get_Paths >

    '='C:\Users\poppr\Desktop\Excel\Excel\20190214_Pfade_aendern\[Excel_mit_Wert_A_inC3.xlsx]Sheet1'!B$2

    Dim sPfad_Alt As String

    sPfad_Alt = "C:\Users\poppr\Desktop\Excel\Excel\20190214_Pfade_aendern\Excel_mit_Wert_A_inC3.xlsx"

    sPfad_Alt = LCase(sPfad_Alt)

   

    Dim sPfad_Neu As String

    sPfad_Neu = "C:\Users\poppr\Desktop\Excel\Excel\20190214_Pfade_aendern\Excel_mit_Wert_B_inC3.xlsx"

    sPfad_Neu = LCase(sPfad_Neu)

    '</ get_Paths >

   

    '< get_Document >

    Application.StatusBar = Now & " start Pfade austauschen von " & sPfad_Alt & " -> " & sPfad_Neu

    Dim wb As Workbook

    Set wb = ActiveWorkbook

    '</ get_Document >

 

    On Error Resume Next    '*if no ole objects or excelLinks exits

           

    '----< @Loop: External_Links >----

    Dim sLink As Variant

    For Each sLink In wb.LinkSources(1)

        '----< IsLinkSource >----

        sLink = LCase(sLink)

        If sLink Like "*" & sPfad_Alt & "*" Then

            '---< Contains_Path >---

            '< replace >

            Dim sLink_neu As String

            sLink_neu = Replace(sLink, sPfad_Alt, sPfad_Neu, , , vbTextCompare)

            '</ replace >

           

            '< change_linksource >

            wb.ChangeLink sLink, sLink_neu, xlLinkTypeExcelLinks

            wb.ChangeLink sLink, sLink_neu, xlLinkTypeOLELinks

            '</ change_linksource >

            '---</ Contains_Path >---

        End If

        '----</ IsLinkSource >----

    Next

    '----</ @Loop: External_Links >----

   

    '< Abschluss >

    On Error GoTo 0

    Application.StatusBar = Now & " Fertig."

    MsgBox "Fertig"

    '</ Abschluss >

    '----------------</ fx_Pfade_austauschen() >----------------

End Sub

Addin-Code

Folgend der addin-code (klassisches Addin in der xlam datei

Der klassische Addin-Code ist deshalb Sinnvoll, weil man keine Exe ausf├╝hren kann.

Addin in klassischem  vba Addin

Option Explicit

Option Compare Text

 

'**************************************************************

'=====================================< Variablen >=====================================

Const ┬░AddinName As String = "Addin_Pfade_anpassen_20190214_1449"

'=====================================</ Variablen >=====================================

 

 

'=====================================< Workbook >=====================================

Private Sub Workbook_AddinInstall()

   '---------------------------------< Workbook_AddinInstall() >---------------------------------

    Dim mBar As CommandBar

    Set mBar = Application.CommandBars(1)

    On Error Resume Next

   

    Dim mMenu As CommandBarControl

    Dim v

    v = Application.CommandBars.FindControl(msoControlPopup, Application.CommandBars(1).Controls(┬░AddinName).ID)

   

   

    If Err.Number > 0 Then

        Set mMenu = mBar.Controls.Add(msoControlPopup, , , 9, False)

        mMenu.Caption = ┬░AddinName

        mMenu.TooltipText = ┬░AddinName

    Else

        Set mMenu = Application.CommandBars.FindControl(msoControlPopup, Application.CommandBars(1).Controls(┬░AddinName).ID)

    End If

 

    Dim vModul As String

    vModul = "" 'sAddinName & ".DieseArbeitsmappe."

   

    '--------------------< Menuepunkte eintragen >--------------------

   

    '------------< Untermenue : Hauptebene >------------

    Dim ctrl1 As CommandBarButton

    Dim mSubMenu As CommandBarControl

   

    '------------< 1 >------------

    Set ctrl1 = mMenu.Controls.Add

    ctrl1.Caption = "Pfade austauschen"

    'ctrl1.Tag = "fxProtect"

    'ctrl1.TooltipText = "INI aus, schuetzen, Pos1"

    ctrl1.OnAction = vModul & "fx_Pfade_austauschen"

    ctrl1.FaceId = 893

    ctrl1.Style = msoButtonIconAndCaption

    ctrl1.BeginGroup = True

    '------------</ 1 >------------

 

   

    '---------------------------------</ Workbook_AddinInstall() >---------------------------------

End Sub

 

 

 

 

Sub Workbook_AddinUninstall()

    '---------------------------------< Workbook_AddinUninstall() >---------------------------------

   Dim mMenu

    On Error Resume Next

    Set mMenu = Application.CommandBars.FindControl(msoControlPopup, Application.CommandBars(1).Controls(┬░AddinName).ID)

    mMenu.Delete

    '---------------------------------</ Workbook_AddinUninstall() >---------------------------------

End Sub

 

'=====================================</ Workbook >=====================================