Příspěvky uživatele

Ja narážam na to, odkiaľ mi vieme, či Novák Petr má mail na nejakom servery, a odkiaľ vieme, či je to novakpetr@xy.cz / petrnovak@xy.cz / novak.petr@xy.cz / ...
Mi to musíme nejako vedieť, keď chcem aby bol hypertextový odkaz funkčný.
A ak to vieme, kto má kde mail v akej podobe, tak postrádam zmysel v tomto spájaní, lebo keď to vieme, niekde takú infošku už asi máme v DB. Či ???

Najskôr si pozrite, či je toto to, čo potrebujete. Potom Vám na to spravím makro, ak dodáte prílohu, aby bolo jasné kde sú data, od ktorého po ktorý riadok, hromadne na X riadkov ...
A vysvetlite, čo myslíte tým odkazom. Hypertextový odkaz? Na mail, ktorý neexistuje? Alebo všetky tie mená majú vytvorený mail? Treba sa zbavovať aj medzier (to som tam dal). Má to byť UDF funkciou (tak ako teraz funguje pri zmene dát), alebo makrom zapísané jednorázovo? Málo info.
PS: odstránenie diakritiky vycucané z riešenia od eLCHa.

Ak chcete z toho mať text:
=TRIM(TEXT(1*SUBSTITUTE(A1;" ";"");"##\ ##\ ##"))
=PROČISTIT(HODNOTA.NA.TEXT(1*DOSADIT(A1;" ";"");"##\ ##\ ##"))
formát Všeobecný

Ak chcete z toho mať číslo:
=1*SUBSTITUTE(A1;" ";"")
=1*DOSADIT(A1;" ";"")
a formát Vlastný
##\ ##\ ##

Nepíšete, čo sa má s tým diať. Uložiť do listu? Na disk? Do mailu? Ak si dáte do Googlu výraz "vba form screenshot" nájdete väčšinou API, no tento kratučký stačí na screenshot do listu:
Private Sub CommandButton1_Click()
Application.SendKeys "(%{1068})"
DoEvents
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
End Sub

Pochybujem, nereálne.

@Jiří497 : Nedávajte tam celý rozsah, ale iba vyplnenú časť, počítanú v Definovanom názve SEZNAM, napr.:
=OFFSET(List1!$AU$208;;;ROWS(List1!$AU$208:$AU$407)-COUNTBLANK(List1!$AU$208:$AU$407))
=POSUN(List1!$AU$208;;;ŘÁDKY(List1!$AU$208:$AU$407)-COUNTBLANK(List1!$AU$208:$AU$407))
A tento def. názov SEZNAM zadajte ako vstupný rozsah prvku.

EDIT: Inak aby nebolo potrebné mať niekde dostatočný počet riadkov pre maticu, tak by som v tej istej dátovej tabuľke vytvoril na to skrytý stĺpec, a o vhodnú veľkosť je postarané.

Predpokladám, že ste priložil súbor s prílohou XLSM. Ale taký súbor fórum nezoberie. Musíte ho zabaliť do ZIP, ktorý je do cca 256 KB.

Také niečo bude trochu krkolomné.
Do modulu:
Sub StartForm()
UserForm1.Show
End Sub

Do formulára:
Dim aPic() As Shape
Dim cPic As Long
Dim ch As ChartObject
Dim stmpFile As String

Private Sub SpinButton1_Change()
If cPic > -1 Then SetImage aPic(SpinButton1.Value)
End Sub
Private Sub UserForm_Initialize()
Dim SHP As Shape
cPic = -1
For Each SHP In wsObr.Shapes
If SHP.Type = msoPicture Then
cPic = cPic + 1
ReDim Preserve aPic(cPic)
Set aPic(cPic) = SHP
End If
Next SHP

If cPic > -1 Then
Set ch = wstmpgraf.ChartObjects("tmpgraf")
stmpFile = ThisWorkbook.Path & "\pic_tmp.bmp"
SpinButton1.Max = cPic
SetImage aPic(0)
End If
End Sub
Sub SetImage(ByRef SHP As Shape)
SHP.Copy
ch.Select
With ch.Chart
.Paste
.Export stmpFile
End With
Image1.Picture = LoadPicture(stmpFile)
Label1.Caption = SpinButton1.Value
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
Kill stmpFile
Erase aPic
Set ch = Nothing
End Sub

CodeName listu s obrázkami : wsObr
CodeName skrytého listu s potrebným pracovným grafom : wstmpgraf
Dočasne vytváraný súbor s obrázkom v aktuálnom umiestnení : pic_tmp.bmp

Použiť môžete nejakú univerzálnejšiu metódu, kde je jedno koľko vnorení budete požadovať. Napr. :
Sub Ulozit()
Dim strCesta As String, strJmeno As String, strFolder As String

With wksUvod
strFolder = .Range("D1").Value & "\" & Year(.Range("B3").Value) & "\" & .Range("B2").Value
strJmeno = .Range("B1").Value
End With

VytvorAdresar strFolder

strCesta = strFolder & "\" & strJmeno & ".xlsm"
ThisWorkbook.SaveAs Filename:=strCesta, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Sub VytvorAdresar(Cesta As String)
Dim sC() As String, dC() As String, i As Byte

If Right$(Cesta, 1) <> "\" Then Cesta = Cesta & "\"
dC = Split(Cesta, ":\")
sC = Split(dC(1), "\")

Cesta = dC(0) & ":"

For i = 0 To UBound(sC)
If sC(i) <> "" Then
Cesta = Cesta & "\" & sC(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
End If
Next i
End Sub
viď tu

Zdroj = "=IF('" & Cesta & "\" & "[" & Nazev & "]" & List & "'!?="""","""",'" & Cesta & "\" & "[" & Nazev & "]" & List & "'!?)"

With Sheets("List1").Range("A1:B2")
.Formula = Replace(Zdroj, "?", "A1")
.Value = .Value
End With

With Sheets("List1").Range("D3:E4")
.Formula = Replace(Zdroj, "?", "D3")
.Value = .Value
End With

Verzia OS a Office ?

OT: Ani nie. Chrbtica ...

Sub Import()

' Import dat z jiného souboru

Dim Cesta As String
Dim Soubor As String
Dim List As String
Dim Zdroj As String
Dim Nazev As String

Cesta = "C:\Users\Downloads"
Nazev = "Zdroj.xlsx"
List = "List1"

Soubor = Cesta & "\" & Nazev

If Dir(Soubor) = "" Then MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical: Exit Sub

Zdroj = "='" & Cesta & "\" & "[" & Nazev & "]" & List & "'!"

With Sheets("List1").Range("A1:B2")
.Formula = Zdroj & "A1:B2"
.Value = .Value
End With

With Sheets("List1").Range("D3:E4")
.Formula = Zdroj & "D3:E4"
.Value = .Value
End With
End Sub

Sub Makro1()
Dim prvy As String, druhy As String, treti As String
Dim PocRia As Long

prvy = "A"
druhy = "G"
treti = "AW"

PocRia = 15

Range("A1").Value = prvy
Range("A2").Value = druhy
Range("A3").Value = treti

Union(Cells(1, prvy).Resize(PocRia), _
Cells(1, druhy).Resize(PocRia), _
Cells(1, treti).Resize(PocRia)).Select
End Sub

Mohla by to byť udalosť listu?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("D2"), Target) Is Nothing Then PageSetup.CenterHeader = Range("D2")
End Sub
ak je to počítaný vzorec, tak napr.
Private Sub Worksheet_Calculate()
PageSetup.CenterHeader = Range("D3")
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje