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

Vba Code: Vorlage Bereich kopieren

04.11.2020 (👁5808)


Diese Word Vorlage macht folgendes:

Es wird der Tabellen Bereich unterhalb von [Vorlage] kopiert und an den Bereich vor der Kennung eingefügt.

Vba Code

·       Platzhalter Markierung suchen in Words

·       Übergeordnete Tabelle als .Range suchen

·       Range copy und Paste

Vba Code Beispiel

Option Explicit On

'----< Setup Parameters >----

Const const_Path_Photos_Default As String = "B:\2020"

Const const_int_maxLength_Photos As String = 17

Const Nr_Table_with_Fotos As Integer = 1

Const Show_Filenames As Boolean = True

Const Show_ImageNr As Boolean = True

Const Add_Empty_Textline As Boolean = True

Const sPlaceholder_Vorlage = "Vorlage"

Public range_Placeholder_Vorlage As Range

Const sPlaceholder_Filename = "Filename"

Public range_Vorlage As Range

'----</ Setup Parameters >----

'=====< BUTTONS >=========

Private Sub btnMarkieren_Click()

    '----< btnMarkieren_Click() >----

    '--< get Template >--

    Set range_Placeholder_Vorlage = get_Placeholder(sPlaceholder_Vorlage)

   

    Dim range_Platzhalter_Filename As Range

    Set range_Platzhalter_Filename = get_Placeholder(sPlaceholder_Filename)

    Set range_Vorlage = range_Platzhalter_Filename.Tables(1).Range

    range_Vorlage.Copy

    '--</ get Template >--

    '< paste to new >

    Dim newRange As Range

    Set newRange = Application.ActiveDocument.Range(range_Placeholder_Vorlage.Start - 1, range_Placeholder_Vorlage.Start - 1)

   

    newRange.Paste

    '</ paste to new >

    '----</ btnMarkieren_Click() >----

End Sub

'=====</ BUTTONS >=========

Private Function get_Placeholder(ByVal sPlatzhalter As String) As Range

    '-----------------< Find_Placeholder() >-----------------

    '< init >

    Dim lenPlaceholder As Integer

    lenPlaceholder = Len(sPlatzhalter)

    Dim doc As Document

    Set doc = Application.ActiveDocument

    '</ init >

    Dim range_Placeholder As Range

    '----< @Loop: Controls >----

    '*loop all Phrases

    Dim i As Long

    For i = 1 To doc.Words.Count - 2

        Dim var As Variant

        Set var = doc.Words(i)

        If var.Text = "[" Then

            Dim varPlatzhalter As Variant

            Set varPlatzhalter = doc.Words(i + 1)

            If varPlatzhalter = sPlatzhalter Then

                '--< Platzhalter gefunden >--

                Set range_Placeholder = var.Paragraphs(1).Range 'satz auswaehlen

                range_Placeholder.SetRange range_Placeholder.Start, range_Placeholder.End - 1 'markieren

                Exit For

                '--</ Platzhalter gefunden >--

            End If

        End If

    Next

   

    Set get_Placeholder = range_Placeholder

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

    '-----------------</ Find_Placeholder() >-----------------

End Function

'

'range_Platzhalter.Text = "ERSETZT"  'ersetzen