Příspěvky uživatele

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

Uveďte ešte verziu Office a jazyk, a aj OS.
Ja mám Office 2019 x64 Pro SK (1808), a Win 10 x64 Pro SK (1909). Nech to môže skúsiť pozrieť niekto, kto má rovnaké podmienky.

Skúste
Range("A2").AutoFilter Field:=1, Criteria1:=Format(Datum, "d.m.yyyy")

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje