Hirdetés
- Drasztikus változást mutat a Sony mobilja az első képeken
- Hatalmas telepet és fizikai ventilátort kaptak az új Oppo-k
- Tizenegyes! A VAR helyett a CAD buktatta le a Google profi játékosát
- Gyorsabb processzort igen, memóriát alig kapott a Xiaomi új HD tévéokosítója
- Ennyit szűkít az X300 Ultra a telepen Európában
-
Mobilarena
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
- Folyószámla, bankszámla, bankváltás, külföldi kártyahasználat
- Huawei Watch Fit 3 - zöldalma
- Azonnali fotós kérdések órája
- Samsung Galaxy Felhasználók OFF topicja
- OLED TV topic
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Xiaomi 17 Ultra - jó az optikája
- Milyen egeret válasszak?
- Fűnyíró topik
- Horgász topik
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- AKCIÓ! MSI ThinA15 B7VF-449XHU Gamer notebook - R7 7735HS 16GB DDR5 1TB SSD nVidia RTX 4060 8GB
- HIBÁTLAN iPhone 15 Plus 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS4504
- HIBÁTLAN iPhone 15 Pro 128GB Black Titanium-1 ÉV GARANCIA - Kártyafüggetlen, MS4660
- Dell Precision 3571 i7-12700H 16GB 512GB FHD RTX T600 4GB 1 év teljeskörű garancia
- Asus ROG Strix GAMER PC! Ryzen 3700X / GTX 1660 Ti / 16GB DDR4 / 512GB NVMe
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50
