< návrat zpět

MS Excel


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

Zaslal/a 20.8.2014 15:05

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ěď >

#021250
avatar
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
#021251
avatar

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
#021252
avatar
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
#021253
avatar
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
#021254
avatar
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
#021258
avatar
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

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 0:34

Vynásobit hodnoty kurzem - Power Query

Alfan • 24.4. 16:32

Relativní cesta - zdroje Power Query

Alfan • 24.4. 15:44

Relativní cesta - zdroje Power Query

elninoslov • 24.4. 14:26

Jak odstraním duplicitní údaje

Mirek8 • 24.4. 12:13

Jak odstraním duplicitní údaje

elninoslov • 24.4. 8:57

Vyhledej

PavDD • 24.4. 8:56