MS Excel

ahoj potřeboval bych poradit zda jde udělat vlastní formát buňky přes VBA, který by za každé číslo v buňce přidal /14, ale s tím, že hodnota za lomítkem by se odvíjela od aktuálního data, které je určeno buňkou A13.

vepsané hodnoty do buňky B1 = C 20 F 35 N 18 a formátování by z toho udělalo C 20/14 F 35/14 N 18/14

a pokud by to nešlo s těmi písmeny tak alespoň pokud by byly vepsány pouze číslice např. z 20 by to udělalo 20/14.
vím že si to můžu udělat ve vlastním formátu, ale jde mi o to zda to nejde udělat dynamicky na základě hodnoty v buňce A13.

A dál by mě ještě zajímalo zda jde nějak uzamknout pouze formátování na listech. Aby se nedaly změnit formáty buněk a výšky řádků a šířky sloupců. jinak by bylo vše normálně přístupné.

Díky za rady.

Zaslat odpověď >

kp57(20.8.2014 18:40)#021250

1) No pokud víš jak to udělat ve Vlastním Formátu(netuším jak), tak použij záznamník. Jinak vzorcem, pokud v B1 má zápis stejný formát(pozice písmen, číslic). Nebo VBA Funkcí.
2) Označit oblast - Formát buněk - zruš zamknout a zamkni List.citovat

adosl(20.8.2014 19:13)#021251

kp57 napsal/a:

1) No pokud víš jak to udělat ve Vlastním Formátu(netuším jak), tak použij záznamník. Jinak vzorcem, pokud v B1 má zápis stejný formát(pozice písmen, číslic). Nebo VBA Funkcí.
2) Označit oblast - Formát buněk - zruš zamknout a zamkni List.

1) no právě nevím jak to udělat s dynamickým datem ani ve vlastním formátu
2) mám moc listů a uvítal bych pokud by to uzamčení šlo udělat makrem, ale uzamčené by mělo být opravdu jen to formátování jinak niccitovat

cmuch1(20.8.2014 19:40)#021252

2) Šloby použít toto

Sub OdemkniOblastListu()
'
Dim Sh As Worksheet
'
For Each Sh In Worksheets
'
With Sh
With .Range("D6:T28")
.Locked = False
.FormulaHidden = False
End With
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Next
End Subcitovat

cmuch1(20.8.2014 19:50)#021253

Oprava, To .Protect... nahraď

.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=Truecitovat

cmuch1(20.8.2014 20:18)#021254

1)
třeba fci

Function DosadRok(Bunka As Range, Rok As Range) As String

DosadRok = Mid(Bunka, 1, 4) & "/" & Rok & Mid(Bunka, 5, 5) & "/" & Rok & Mid(Bunka, 10, 5) & "/" & Rok

End Functioncitovat

kp57(20.8.2014 20:52)#021258

1)No vzhledem k tomu, že si uvažoval o Vl.Formátu, chceš aby se změna projevila v té buňce, ve které daný text zapíšeš. Ne?. V tom případě jedině Udalostní prc.Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyStrA As String, MyStrB As String, MyNum As String
Dim MyChr As String, pzcChr As Byte, Rok As Byte
If Target = "" Then Exit Sub
If Not IsDate(Range("A13")) Then Exit Sub
Application.EnableEvents = False
MyStrA = Target: MyStrB = vbNullString: MyNum = vbNullString
Rok = Year(Range("A13")) Mod 1000
For pzcChr = 1 To Len(MyStrA)
MyChr = Mid(MyStrA, pzcChr, 1)
If Not IsNumeric(MyChr) Or pzcChr = Len(MyStrA) Then
If IsNumeric(MyNum) And pzcChr = Len(MyStrA) Then
MyStrB = MyStrB & MyNum & MyChr & "/" & Rok
MyNum = vbNullString
ElseIf IsNumeric(MyNum) Then
MyStrB = MyStrB & MyNum & "/" & Rok & " "
MyNum = vbNullString
Else
MyStrB = MyStrB & MyChr
End If
Else
MyNum = MyNum + MyChr
End If
Next pzcChr
Target = MyStrB
Application.EnableEvents = True
End Sub
citovat

Téma: vlastní formát buněk přes VBA

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje