Hirdetés
-
PROHARDVER!
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Ú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?
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
- Telefon felvásárlás!! Xiaomi Redmi Note 13, Xiaomi Redmi Note 13 Pro, Xiaomi Redmi Note 13 Pro+
- GYÖNYÖRŰ iPhone 13 Mini 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS4066, 94% AKKSI
- AKCÓ! HTC VIVE Pro 2 virtuális valóság szemüveg garanciával hibátlan működéssel
- MacBook felváráslás!! MacBook, MacBook Air, MacBook Pro
- Lenovo ThinkPad T14s Gen 3 i5-1245U 14" FHD+ 16GB 512GB 1 év teljeskörű garancia
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs

Fferi50

