-
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
- Counter-Strike: Global Offensive (CS:GO) / Counter-Strike 2 (CS2)
- Épített vízhűtés (nem kompakt) topic
- Projektor topic
- OLED TV topic
- Autós topik látogatók beszélgetős, offolós topikja
- Gyúrósok ide!
- exHWSW - Értünk mindenhez IS
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Házimozi belépő szinten
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- További aktív témák...
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- GYÖNYÖRŰ iPhone 11 Pro 64GB Silver -1 ÉV GARANCIA - Kártyafüggetlen, MS3565
- Adata DDR5 5600 RAM 2x8 GB
- iKing - Apple iPhone 15 Pro Natural Titanium ProMotion 120 Hz, A17 Pro, USB-C 128 GB
- BESZÁMÍTÁS! HP Elitedesk 800 G4 SFF számítógép - i5 8500 16GB DDR4 256GB SSD Intel UHD 630 250W W11
- ÁRGARANCIA! Épített KomPhone i5 10400F 16/32GB/64GB RAM RTX 5050 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs

Fferi50
