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: 69319 Skopiuj do schowka export do worda korekta formatowania tekstu w word
Autor Wiadomość
stavic
Exceloholic


Posty: 249
Wysłany: 12-11-2020, 15:28   export do worda korekta formatowania tekstu w word

Proszę o pomoc w poprawie poniższego makra.
Obecnie makro wrzuca mi do pliku worda kolejno wartości z trzech kolumn z każdego wiersza.
Potrzebuję zmienić kod tak aby wartości z drugiej i trzeciej kolumny miały wcięcie tabulatora lub były przesunięte kilka spacji w prawo (jak podpunkty). kombinowałem z dołożeniem spacji do zmiennych

Kod:

 .ParagraphFormat.Alignment = 3
    .Font.Bold = True
            zmienna = Worksheets("swiadectwo").Cells(licznik, 1).Value: .TypeText zmienna
            .TypeParagraph
                     
    .Font.Bold = False
            zmienna = "    " & Worksheets("swiadectwo").Cells(licznik, 2).Value: .TypeText zmienna
            .TypeParagraph
         
    .Font.Bold = False
            zmienna = "    " & Worksheets("swiadectwo").Cells(licznik, 3).Value: .TypeText zmienna
            .TypeParagraph
         
    Next licznik


ale nie daje to oczekiwanego efektu. Szczegóły w załączniku graficzne zobrazowanie do czego dąże też w załączniku.



Kod:

Sub drukuj_do_worda()

Dim ApVer As Variant
Dim nazwa As String
Dim WordApp As Object
Dim SaveAsName As String
Dim i As Integer
Dim j As Integer
Dim suma_recznie As Single
Dim suma_auto As Single
Dim zmienna As String
Dim ile_zakresow As Integer
Dim licznik As Integer
   



'kontrola wersji Office'a
ApVer = Application.Version
ApVer = Val(ApVer)
If ApVer < 10 Then
MsgBox "Ta metoda działa na offisie od wersji 2002"
GoTo koniec
End If


'uruchamianie Worda i utworzenie obiektu (późne wiązanie)
Set WordApp = CreateObject("Word.Application")

'8 nazwa = Worksheets("swiadectwo").Range("A1") & " - " & Worksheets("swiadectwo").Range("B1")
'nazwa = ZamZnakiNiedozwolone(nazwa)     'funkcja usuwająca znaki niedozwolone

'SaveAsName = ActiveWorkbook.Path & "\" & nazwa & ".doc"


'wysyłanie poleceń do Worda
With WordApp
    .Documents.Add
   
    With .ActiveDocument.PageSetup 'parametry marginesow
            .TopMargin = Application.CentimetersToPoints(1.5)
            .BottomMargin = Application.CentimetersToPoints(2.5)
            .LeftMargin = Application.CentimetersToPoints(1.5)
            .RightMargin = Application.CentimetersToPoints(1.5)
            .FooterDistance = Application.CentimetersToPoints(1)
    End With
   
    With .Selection
           
            .Font.Name = "Times New Roman"
            .Font.Size = 12
            .ParagraphFormat.SpaceBefore = 0
            .ParagraphFormat.SpaceAfter = 0
            .ParagraphFormat.LineSpacing = 12 'pojedyncze odstepy miedzy wierszami
           
           
          'TREŚĆ dwa entery na początku
            .TypeParagraph
            .TypeParagraph
         
         
    For licznik = 1 To 10
   
         
    .ParagraphFormat.Alignment = 3
    .Font.Bold = True
            zmienna = Worksheets("swiadectwo").Cells(licznik, 1).Value: .TypeText zmienna
            .TypeParagraph
                     
    .Font.Bold = False
            zmienna = "    " & Worksheets("swiadectwo").Cells(licznik, 2).Value: .TypeText zmienna
            .TypeParagraph
         
    .Font.Bold = False
            zmienna = "    " & Worksheets("swiadectwo").Cells(licznik, 3).Value: .TypeText zmienna
            .TypeParagraph
         
    Next licznik
       
   
    'otworzenie dokumentu
    WordApp.Visible = True
    Set WordApp = Nothing
       
    'odtworzenie paska stanu
    'Application.StatusBar = ""
    'MsgBox Records & " świadectwo utworzono i zapisano w " & ThisWorkbook.Path
    MsgBox "świadectwo o nazwie:" & vbNewLine & _
            nazwa & vbNewLine & _
            "zostało utworzone i otworzone w tle." & vbNewLine & _
            vbNewLine & _
            "Możesz je normalnie edytować." & vbNewLine & _
            "Jeśli chcesz zarchiwizawać dokument zapisz go - F12"
   
    'jezeli udalo sie zapisac dokument to przeskok do etykiety "jest_dobrze"
    GoTo jest_dobrze

nic_z_tego_nie_bedzie:
    MsgBox "Dokument o nazwie:" & vbNewLine & _
            nazwa & vbNewLine & _
            "jest już otwarty" & vbNewLine & _
            "przed próbą zapisu musisz go zamknąć"
    WordApp.Quit SaveChanges:=0
    GoTo koniec
   
jest_dobrze:
koniec:
End With
End With
End Sub


Dziękuję za wszelką pomoc

do word.xlsm
Pobierz Plik ściągnięto 15 raz(y) 51.39 KB

ID posta: 394927 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2495 razy
Posty: 8287
Wysłany: 13-11-2020, 07:45   

stavic, to będzie chyba kwestia ustawień WORD-a, bo u mnie po uruchomieniu makra mam taki rezultat jakiego oczekujesz. Może kwestia ustawień punktatorów, nie wiem ?
Wiem że na pewno mam ustawienia standardowe, bo po instalacji nic nie zmieniałem.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 394962 Skopiuj do schowka
 
 
J_B 
Excel Expert


Wersja: Win Office 2016
Pomógł: 541 razy
Posty: 1339
Wysłany: 13-11-2020, 11:55   

stavic napisał/a:
Potrzebuję zmienić kod tak aby wartości z drugiej i trzeciej kolumny miały wcięcie tabulatora lub były przesunięte kilka spacji w prawo (jak podpunkty). kombinowałem z dołożeniem spacji

Sprawdź załącznik
Janusz

do word.xlsm
Pobierz Plik ściągnięto 12 raz(y) 52.36 KB

ID posta: 394969 Skopiuj do schowka
 
 
stavic
Exceloholic


Posty: 249
Wysłany: 13-11-2020, 14:59   

U mnie niestety tak nie działa. Ale rozwiązanie J_B działa idealnie wielkie dzięki (podziękowałem również punktem).
ID posta: 394974 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