Hirdetés

Új hozzászólás Aktív témák

  • poffsoft

    veterán

    válasz poffsoft #37556 üzenetére

    Nos, eddig jutottam.
    Az utolsó sor kijelölése már nem sikerül, így a selection miatt rossz területen változik a stílus.
    Valaki? :N
    Public Sub masol()
    Dim WSheets As Integer, WS1 As Worksheet, WS2 As Worksheet
    Dim b As Range
    Dim usor As Long, sor As Long, oszlop As Integer
    Dim myPath As String
    Dim folderPath As String

    Dim MyText As String
    Dim MyRange As Object
    Dim myWRange As Object

    Set Wordapp = CreateObject("word.Application")
    For WSheets = 1 To 1 'Worksheets.Count
    Set WS1 = Sheets(WSheets)
    folderPath = Application.ActiveWorkbook.Path
    usor = Range("A" & Rows.Count).End(xlUp).Row + 1
    With Wordapp
    .documents.Open folderPath & "\temp.docx"
    a = .documents.Count
    .documents(a).SaveAs Filename:=folderPath & "\" & WS1.Name & ".docx" ', FileFormat:=wdFormatDocumentDefault
    .Visible = True
    'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI

    MyText = WS1.Range("A1")
    .documents(a).Range.InsertAfter (MyText)

    .Selection.Style = .documents(a).Styles("List_M")
    .documents(a).Range.InsertparagraphAfter
    'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI

    MyText = "C. Témacsoportok az üzem-specifikus kérdésekhez"
    .documents(a).Range.InsertAfter (MyText)
    .Selection.Style = .documents(a).Styles("List_0")
    .documents(a).Range.InsertparagraphAfter
    'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI

    For oszlop = 3 To 31
    For sor = 6 To 8
    MyText = WS1.Cells(sor, oszlop)
    If MyText <> "" Then
    .documents(a).Range.InsertAfter (MyText)
    .Selection.Style = .documents(a).Styles("List_" & sor - 5)
    .documents(a).Range.InsertparagraphAfter
    'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI

    End If
    Next sor
    For sor = 10 To usor
    If WS1.Cells(sor, oszlop) <> "" Then
    .documents(a).Range.InsertAfter (WS1.Cells(sor, 1))
    .Selection.Style = .documents(a).Styles("List_norm")
    .documents(a).Range.InsertparagraphAfter
    'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI

    End If
    Next sor
    Next oszlop
    MyRange.Selection.Collapse Direction:=wdCollapseend
    .documents(a).Range.InsertparagraphAfter
    End With
    Wordapp.documents(a).Close
    Next WSheets
    Wordapp.Quit
    End Sub

Új hozzászólás Aktív témák