Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 59253 Skopiuj do schowka word kopiowanie zaznaczonego tekstu do nowego worda
Autor Wiadomość
stavic
Exceloholic


Posty: 134
Wysłany: 01-11-2017, 17:14   word kopiowanie zaznaczonego tekstu do nowego worda

Pytanie dotyczy Worda (nie znalazłem wordowskiego forum takiego jak Excelforum)
może ktoś pomoże?
W Wordzie mam makro które wyszukuje tekst zawarty pomiędzy wyrazami Start i End
Kod:

Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Start" and "End" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strTheText As String

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Start") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="End") Then
            strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
            MsgBox strTheText
        End If
    End If
End Sub


Jak zmienić powyższy kod aby do nowego dokumentu worda skopiowac tekst pomiędzy Start i End
lub skopiować tylko tekst zaznaczony myszka (aktywny obszar).

Dziękuję za wszelką pomoc

kopia.docx
Pobierz Plik ściągnięto 35 raz(y) 17.21 KB

ID posta: 333299 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1147 razy
Posty: 3956
Wysłany: 01-11-2017, 19:14   Re: word kopiowanie zaznaczonego tekstu do nowego worda

stavic napisał/a:

Jak zmienić powyższy kod aby do nowego dokumentu worda skopiowac tekst pomiędzy Start i End

Twój kod nie znajdzie tekstu między Start i End. On znajdzie kod między Start i end - pierwszy end po Start. Musisz dać dodatkowo MatchCase:=True
Kod:

Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Start" and "End" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Start", MatchCase:=True) Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="End", MatchCase:=True) Then
            ActiveDocument.Range(rng1.End, rng2.Start).Copy
            With Application.Documents.Add
                .Range.Paste
                .SaveAs2 ThisDocument.Path & "\hic hic.docx"
'                .Close
            End With
        End If
    End If
End Sub

Cytat:

lub skopiować tylko tekst zaznaczony myszka (aktywny obszar).

Kod:

Sub RevisedFindIt()
    Selection.Copy
    With Application.Documents.Add
        .Range.Paste
        .SaveAs2 ThisDocument.Path & "\hic hic.docx"
'        .Close
    End With
End Sub
ID posta: 333303 Skopiuj do schowka
 
 
stavic
Exceloholic


Posty: 134
Wysłany: 01-11-2017, 22:08   

Czy możesz połączyć przedstawione przez Ciebie rozwiązania w jedno?
Czyli kopia "nagłówka" od Start do End i kopia zaznaczonego obszaru do nowego pliku,
Próbuje zrobić makrem wyciąg z dokumentu, jednak moje próby nie dają oczekiwanego efektu.
Ostatnie pytanie czy można wskazać "naglówek" dokumentu (pierwsze cztery linie) w inny sposób niż w makrze które przedstawiłem na początku?
ID posta: 333306 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1147 razy
Posty: 3956
Wysłany: 02-11-2017, 00:25   

Cytat:

Czy możesz połączyć przedstawione przez Ciebie rozwiązania w jedno?
Czyli kopia "nagłówka" od Start do End i kopia zaznaczonego obszaru do nowego pliku,
Próbuje zrobić makrem wyciąg z dokumentu, jednak moje próby nie dają oczekiwanego efektu

Kod:

Sub RevisedFindIt()
Dim rng1 As Range
Dim rng2 As Range
Dim doc As Document
    Selection.Copy
    Set doc = Application.Documents.Add
    Selection.TypeParagraph
    Selection.Paste
    Set rng1 = ThisDocument.Range
    If rng1.Find.Execute(FindText:="Start", MatchCase:=True) Then
        Set rng2 = ThisDocument.Range(rng1.End, ThisDocument.Range.End)
        If rng2.Find.Execute(FindText:="End", MatchCase:=True) Then
            ThisDocument.Range(rng1.End, rng2.Start).Copy
            With doc
                .Range(0, 0).Paste
                .SaveAs2 ThisDocument.Path & "\hic hic.docx"
'                .Close
            End With
        End If
    End If
End Sub

Cytat:

Ostatnie pytanie czy można wskazać "naglówek" dokumentu (pierwsze cztery linie) w inny sposób niż w makrze które przedstawiłem na początku?

Nic nie proponuję. Przecież to zależy od szczegółów.
1. Czy to naprawdę 4 linie, czyli po każdej jest Enter? A może po prostu to jest długi tekst bez Enter'a a tekst sam się zwija do 4 linii?
2. Czy chcesz użyć 1 kodu do różnych plików źródłowych?
itd.

Przykład: wybierz cały nagłówek -> dodaj jako bookmark o nazwie naglowek -> zaznacz obszar -> uruchom kod
Kod:

Sub RevisedFindIt()
    Selection.Copy
    With Application.Documents.Add
        Selection.TypeParagraph
        Selection.Paste
        ThisDocument.Bookmarks("naglowek").Range.Copy
        .Range(0, 0).Paste
        .SaveAs2 ThisDocument.Path & "\hic hic.docx"
'        .Close
    End With
End Sub
ID posta: 333307 Skopiuj do schowka
 
 
stavic
Exceloholic


Posty: 134
Wysłany: 07-11-2017, 19:44   

dziękuje za pomoc pkt przyznany
ID posta: 333663 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe