Ahojte :)
ráda bych požádala o radu. Potřebovala bych nějaké makro vázané na tlačítko, které by useklo část textu v buňce. Nestačí mi ale funkce ČÁST, potřebuji, aby useklo celé slovo, které se do řádku nevejde... existuje něco takového? Řekněme, že bych povolila 20 znaků, ale nechci aby mi "ukousl" část slova...
Děkuju za radu!! :)
Excel - část textu v buňce
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Excel - část textu v buňce
Do řádku se vejde spousty znaků,
přilož nějakou ukázku se stavem před useknutím a po useknutí.
přilož nějakou ukázku se stavem před useknutím a po useknutí.
Re: Excel - část textu v buňce
Třeba tady... viz buňka C7 - potřebuji tlačítko, které by useklo konec textu v buňce tak, aby zbylo "maintenance of public" ... jde to? :)
Děkuji moc za ochotu :)
Děkuji moc za ochotu :)
- Přílohy
-
- useknutí buněk.xlsx
- (10.91 KiB) Staženo 59 x
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Excel - část textu v buňce
Tady je makro, které by to mohlo splnovat.
Provede se pouze na aktivni bunce, v makru si lze upravit treba pro oblast.
Tlačítko určitě vložit dokážeš.
Provede se pouze na aktivni bunce, v makru si lze upravit treba pro oblast.
Kód: Vybrat vše
Sub ZkratText()
'zkraceni vety na cele slova podle sirky sloupce
'pro aktivni bunku / ne sloucenou !!!!!!!!!!
Dim rngBunka As Object
Dim ActRow As Integer, ActClm As Integer
Dim puvodnitext As String
Dim puvodnisirkasloupce, novasirkasloupce
Dim pocetvlozenychznaku As Integer, sirka As Integer, mezera As Integer
ActRow = ActiveCell.Row
ActClm = ActiveCell.Column
Set rngBunka = Cells(ActRow, ActClm)
puvodnitext = rngBunka.Text
'je bunka sloucena?
If rngBunka.MergeCells = True Then
MsgBox "Bunka nesmi byt sloucena !!", vbCritical, "Error"
Exit Sub
Else
puvodnisirkasloupce = rngBunka.ColumnWidth
End If
Application.ScreenUpdating = False
pocetvlozenychznaku = 1 'pocet znaku v bunce
novasirkasloupce = 0
'zruseni zalomeni textu
rngBunka.WrapText = False
'projdi text a porovnej jeho sirku s sirkou sloupce
For sirka = 1 To Len(puvodnitext)
If puvodnisirkasloupce > novasirkasloupce Then
With rngBunka
.Value = Mid(puvodnitext, 1, pocetvlozenychznaku)
.Columns.AutoFit
novasirkasloupce = .ColumnWidth
'posledni mezera
If Mid(puvodnitext, pocetvlozenychznaku, 1) = " " Then
mezera = pocetvlozenychznaku
End If
End With
pocetvlozenychznaku = pocetvlozenychznaku + 1
Else
rngBunka.Value = Mid(puvodnitext, 1, mezera - 1)
Exit For
End If
Next sirka
'povoleni zalomeni textu
rngBunka.WrapText = True
'nastaveni puvodni sirky
rngBunka.ColumnWidth = puvodnisirkasloupce
Application.ScreenUpdating = True
End Sub
Tlačítko určitě vložit dokážeš.
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Otravna reklama zabirajici cast obrazovky Příloha(y)
od petr22 » 20 zář 2023 14:05 » v PC-HELP - připomínky k fóru - 29
- 12373
-
od Ltb
Zobrazit poslední příspěvek
07 říj 2023 00:11
-
-
- 3
- 1645
-
od BigSandy
Zobrazit poslední příspěvek
26 kvě 2023 09:49
-
-
Ilustrator 2020 - problém textu v křivce Příloha(y)
od showpayne » 13 srp 2023 17:50 » v Design a grafické editory - 4
- 2111
-
od Grander
Zobrazit poslední příspěvek
14 srp 2023 14:44
-
-
-
Libre Office Calc - Divné chování při kopírování textu Příloha(y)
od EZumrova » 02 dub 2024 08:12 » v Kancelářské balíky - 14
- 2139
-
od kecalek
Zobrazit poslední příspěvek
05 dub 2024 19:11
-
-
- 16
- 6324
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti