Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - export do worda korekta formatowania tekstu w word

stavic · Exceloholic Posty: 249

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

Marecki · 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.

J_B · Wysłany: 13-11-2020, 11:55

stavic · Exceloholic Posty: 249

U mnie niestety tak nie działa. Ale rozwiązanie J_B działa idealnie wielkie dzięki (podziękowałem również punktem).