[Kopiowanie oznaczeń] Kopiowanie oznaczeń dla letatwina #word #vba

KopiowanieOznaczenWord.vb

Sub KopiujOznaczeniaDoSchowka()
'
' Kopiuje oznaczenia z kolumn w tabeli przewodow
' Zaznaczamy tylko 3 kolumny Ozn1, Konc2, Ozn2
' zadna z komorek nie moze byc scalona
'
    Dim rowsCount, cellsCount, i As Integer
    Dim ozn1Txt, ozn2Txt, oznGotowe As String
    Dim col1, col2 As Object
    
    If Selection.Information(wdWithInTable) = True Then
        rowsCount = Selection.rows.Count
        cellsCount = Selection.cells.Count
        'Set col1 = Selection.Columns(1)
        'Set col2 = Selection.Columns(3)
        
        For i = 1 To cellsCount
            ozn1Txt = Trim(Selection.cells(i).Range.Text)
            ozn2Txt = Trim(Selection.cells(i + 2).Range.Text)
            i = i + 2
            ozn1Txt = Trim(Left(ozn1Txt, Len(ozn1Txt) - 2))
            ozn2Txt = Trim(Left(ozn2Txt, Len(ozn2Txt) - 2))
            c1 = Asc(ozn1Txt)
            c2 = Asc(ozn2Txt)
            If ozn1Txt <> " " And c1 <> 160 And ozn1Txt <> "" Then
                oznGotowe = oznGotowe & ozn1Txt & vbNewLine
            End If
            If ozn2Txt <> " " And c2 <> 160 And ozn2Txt <> "" Then
                oznGotowe = oznGotowe & ozn2Txt & vbNewLine
            End If
        Next i
        CopyText oznGotowe
    Else
        MsgBox "The insertion point is not in a table."
    End If
    
End Sub


Sub CopyText(Text As String)
    'VBA Macro using late binding to copy text to clipboard.
    'By Justin Kay, 8/15/2014
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub