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
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.