• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Zkusím to, ale pošli celý sešit, samotný kód nevyzkouším.

Omlouvám se, blbě jsem to vytáhl z rozsáhlejšího kódu, tohle jsem pro jistotu vyzkoušel a funguje to.

Sub pokus()
awb_name = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

' uložení sešitu do standadní cesty ukládání
ActiveWorkbook.SaveAs ("sesit5.xlsm")

' zavrení nove vytvoreného sešitu
awb2_name = ActiveWorkbook.Name
Workbooks.Open Filename:=awb_name
Windows(awb2_name).Close
End Sub

Awb_name=ActiveWorkbook.path & "\" & activeworkbook.name

' uložení sešitu do standadní cesty ukládání
ActiveWorkbook.SaveAs (cele_jmeno)

' zavření nově vytvořeného sešitu
ActiveWorkbook.Close

Workbooks.Open Filename:= Awb_name

Zkus porovnat nastavení tiskárny, Zejména formát papíru.

Myslel jsem to asi takhle

Co si rozhodit intervaly do různých řad a těm potom přiřadit barvy.

Pokud to potřebuješ ve tvaru číselného vyjádření

tak tohle

Function DatumNarozeni(RodneCislo)
rok = Left(RodneCislo, 2)
mesic = Mid(RodneCislo, 3, 2)
den = Mid(RodneCislo, 5, 2)
If mesic > 50 Then mesic = mesic - 50
If rok > 20 Then
rok = rok + 1900
Else
rok = rok + 2000
End If
DatumNarozeni = den & ". " & mesic & ". " & rok
DatumNarozeni = DateValue(DatumNarozeni)
End Function

Co tohle,

Bohužel to má jistá omezení rok je v rodném čísle pouze dvoumístný takže pro stoleté to nefunguje. To už si snad doladíš.

Function DatumNarozeni(RodneCislo)
rok = Left(RodneCislo, 2)
mesic = Mid(RodneCislo, 3, 2)
den = Mid(RodneCislo, 5, 2)
If mesic > 50 Then mesic = mesic - 50
If rok > 20 Then
rok = rok + 1900
Else
rok = rok + 2000
End If
DatumNarozeni = den & ". " & mesic & ". " & rok
End Function

Díky, to je ono

Dík za rady, ale tohle je v makru, které vybírá z vice variant textu nepoužitelné.

Mám na mysli něco jako tohle

ActiveCell= "AAA" & chr(13) & "BBB"

tohle vypíše v buňce

AAA
BBB

Nemám na mysli indexy pole, ale horní a dolní index jako grafickou úpravu textu.

asi něco takového jako příloha

A co takhle

označit oblast, kterou chci prohledat, stisknout ctrl f , zapsat hledaný text a stisknout tlačítko najít vše.

Dobré ráno,

lze nějakým způsobem zadat do řetězce text z horními a dolními indexy?

Dobrý den,

tohlento jsem vygooglil. Přidá to nabídku napravý click myši. Funguje to bezvadně jenom bych potřeboval volat proceduru s parametrem.

asi něco ja ko toto

.OnAction = "Kalibrace_plna(Bunka)"

ale to nefunguje. Zatím jsem to vyřešil

Public Bunka as Range

a voláním bez parametru

Chyby způsobené globálními proměnnými se špatně hledají, proto bych se tomuradši vyhnul.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim cBut As CommandBarButton
Set Bunka = Target
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Kalibrace plna").Delete
Set cBut = .CommandBars("Cell").Controls.Add(Temporary:=True)
End With
With cBut
.Caption = "Kalibrace plna"
.Style = msoButtonCaption
.OnAction = "Kalibrace_plna"
End With
On Error GoTo 0
End Sub

Když se najde řešení, obvykle se najde řešení jednodušší.

Omlouvám se mám angliclé Office, ale snad to pomůže.

levé tlačítko myši Format cells --- Number --- custom--- 0000

Při zadání 1 do buňky zobrazí 0001

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse