Není to v té samé buňce, ale třeba Vám to pomůže.
Příloha: 
42789_heslo-do-bunky.xlsx (13kB, staženo 26x)
citovat42789_heslo-do-bunky.xlsx (13kB, staženo 26x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Heslo do bunky
MS Excel
Téma: Heslo do bunky 
Zaslal/a Marw 21.2.2019 19:56
Ahoj,
potřeboval bych poradit s jedním problémem. Potřebuji, když se do určité bunky napiše definované heslo tak se v bunce zobrazí jméno uživatele.
Např. do bunky se napíše heslo 1234, a v té samé bunce se objeví Novák, napiše se heslo 4321, v bunce se objeví Dvořák atd... .
Když se zadá heslo, které není definované, tak se v bunce neobjeví nic.
Díky za pomoc.
Marv
vypadá to dobře, ale potřebuji to v aby to bylo v té jedné bunce. I tak moc díky za pomoc.citovat
Jedine udalostné makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Jmeno As String
If Not Intersect(Cells(3, 2), Target) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
Jmeno = WorksheetFunction.VLookup(Cells(3, 2), wsData.ListObjects("tblHesla").DataBodyRange, 2, False)
Cells(3, 2) = IIf(Err.Number = 0, Jmeno, Empty)
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Jmeno As String
If Not Intersect(Cells(3, 2), Target) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
Jmeno = WorksheetFunction.VLookup(Cells(3, 2), wsData.ListObjects("tblHesla").DataBodyRange, 2, False)
Cells(3, 2) = IIf(Err.Number = 0, Jmeno, Empty)
Application.EnableEvents = True
End If
End Sub
Příloha: 
42792_heslo-do-bunky.zip (17kB, staženo 33x)
citovat42792_heslo-do-bunky.zip (17kB, staženo 33x)díky moc, to je přesně to co potřebuji. ještě jedna věc, potřeboval bych to rozšířit na určitou oblast, např. B4:O4. Zkoušel jsem to upravit oblasti, ale nějak se nedařilo. Můžu ještě poprosit o radu?
Díky.
M.citovat
Díky.
M.citovat
Zvládne to aj hromadnú zmenu.
Příloha: 42802_heslo-do-bunky.zip (19kB, staženo 35x)
citovat42802_heslo-do-bunky.zip (19kB, staženo 35x)Dobrý den,
ještě se vracím k tématu "heslo do bunky". Nyní mám program, kde po napsání hesla se přiřadí jméno. Tabulka s hesly a jmény je definovaná v listu, který je součástí excelového souboru. Potřeboval bych ale mít hesla jako zvlášt soubor a s tohoto souboru jména a hesla načítat.
Děkuji za Vaši pomoc.
Marv.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Jmena() As String, Jmeno As String, i As Byte, Zmena As Range, Bunka As Range, Area As Range, Hladaj As Range
Set Zmena = Intersect(Cells(20, 2).Resize(, 22), Target)
If Not Zmena Is Nothing Then
Application.EnableEvents = False
Set Hladaj = ws_Hesla.ListObjects("tblHesla").DataBodyRange
On Error Resume Next
For Each Area In Zmena.Areas
With Area
ReDim Jmena(1 To 1, 1 To .Cells.Count)
i = 0
For Each Bunka In .Cells
i = i + 1
Jmeno = WorksheetFunction.VLookup(Bunka, Hladaj, 2, False)
Jmena(1, i) = IIf(Err.Number = 0, Jmeno, Empty)
Err.Clear
Next Bunka
.Value = Jmena
End With
Next Area
Application.EnableEvents = True
End If
End Sub
citovat
ještě se vracím k tématu "heslo do bunky". Nyní mám program, kde po napsání hesla se přiřadí jméno. Tabulka s hesly a jmény je definovaná v listu, který je součástí excelového souboru. Potřeboval bych ale mít hesla jako zvlášt soubor a s tohoto souboru jména a hesla načítat.
Děkuji za Vaši pomoc.
Marv.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Jmena() As String, Jmeno As String, i As Byte, Zmena As Range, Bunka As Range, Area As Range, Hladaj As Range
Set Zmena = Intersect(Cells(20, 2).Resize(, 22), Target)
If Not Zmena Is Nothing Then
Application.EnableEvents = False
Set Hladaj = ws_Hesla.ListObjects("tblHesla").DataBodyRange
On Error Resume Next
For Each Area In Zmena.Areas
With Area
ReDim Jmena(1 To 1, 1 To .Cells.Count)
i = 0
For Each Bunka In .Cells
i = i + 1
Jmeno = WorksheetFunction.VLookup(Bunka, Hladaj, 2, False)
Jmena(1, i) = IIf(Err.Number = 0, Jmeno, Empty)
Err.Clear
Next Bunka
.Value = Jmena
End With
Next Area
Application.EnableEvents = True
End If
End Sub
citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články