-
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
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Több száz játékban kezdi meg karrierjét az FSR Redstone
- Autós topik
- Amit látnod kell 80’ – 90’ évek, egész estét betöltő mozi filmjei.
- TCL LCD és LED TV-k
- Windows 10
- Xbox Series X|S
- Íme az új Android Auto!
- Otthoni hálózat és internet megosztás
- Mesébe illő csodakábelt tervezett a GeForce-ok leégése ellen a Segotep?
- További aktív témák...
- Keresem a Barkács Balázs Játékokat
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- MS SQL Server 2016, 2017, 2019
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.13.)
- Felújított laptopok számlával, garanciával! Ingyen Foxpost!
- HIBÁTLAN iPhone 12 Pro Max 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3670 100% Akkumulátor
- Xiaomi Redmi 14C 128GB, Kártyafüggetlen, 1 Év Garanciával
- GYÖNYÖRŰ iPhone XR 128GB Red-1 ÉV GARANCIA - Kártyafüggetlen, MS3984, 100% Akkumulátor
- Lenovo Thunderbolt 3 kábel (4X90U90617)
Állásajánlatok
Cég: BroadBit Hungary Kft.
Város: Budakeszi
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest

Fferi50
