-
Fototrend
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
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- HP. Laptop. i5. Model: 15-da1002nq
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- SMAILIO HD 5" GPS autós navigáció
- 27% - ASUS ROG Ryuo IV SLC 360 ARGB (90RC0151-B0EAY0) AIO Vízhűtés !
- Apple iPhone 13 Pro Max / 128GB / Kártyafüggetlen / 12Hó Garancia / Akku:86%
- ASUS Zenbook 14 - 14" 2.8K OLED 90Hz - i5-1240P - 16GB - 512GB - Win11 - 1,5 év garancia - MAGYAR
- ÁRGARANCIA!Épített KomPhone i9 14900KF 32/64GB DDR5 RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50