excel, návod, tipy, funkce, makra, vba, tabulky, šablony

Váš průvodce programem Microsoft Excel a programováním maker ve VBA

Příspěvky uživatele

< návrat zpět

Děkuji

V příloze zasílám ukázku.
Včetně hlavní složky a podsložek.

Samozřejmě sešit bude na ploše a obrázky umístěné ve složce na příklad G:\Rodina

To co jste mi poslal v příloze bylo na vyhledávání souboru bez koncovky to je OK.
Zapracoval jsem to makro do sešitu obrázků a podle jména obrázku by se měl daný obrázek zobrazit což funguje pokud jsou obrázky v jedné složce jenomže je mám i v podsložkách a to mi neukazuje.

Děkuji

Dobrý den,
chtěl bych se zeptat je možné, aby šlo přejmenovat i jiné soubory které nemají neobsahují "_".

Aby to našetlo všechny soubory ne jen "_"

A větší počet souborů ne jen 1000.

Děkuji za Vaši odpověď popřípadě vzor.

Dobrý den,
vyhledávání souborů je OK
Ale ty obrázky, aby se zobrazili musejí být v jedné složce, bohužel je mám rozdělené Hlavní složka a pak jsou podsložky v té dané složce.
Potřebuji, aby se obrázky zobrazovali i když jsou v podsložce což mi nejde.

V příloze zasílám vzor.

Děkuji

Děkuji to je ono.

--------

Ještě bych se chtěl zeptat na kód, který zobrazí obrázky jenomže potřebuji, aby to zobrazovalo obrázky ne jen ze složky, ale i podsložek.

Kód je:

Sub TestVlozitObrazek()

Dim rngOblastObrazek As Range
Dim strCestaSouborObrazek As String

'definice oblasti pro vložení obrázku
Set rngOblastObrazek = Worksheets("List1").Range("I2:O25")

'zdroj obrázku
strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek1.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek2.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek3.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek4.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek5.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek6.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek7.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek8.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek9.jpg"
'strCestaSouborObrazek = ThisWorkbook.Path & "\obrazek10.jpg"

'vymazání případných původních obrázků v oblasti
Call OblastSmazatObjekty(rngOblastObrazek)

'vložení obrázku do oblasti
'vycentrování v obou směrech a nevynucené přizpůsobení
'tj. větší obrázky se zmenší, menší obrázky se nezvětší
Call VlozitObrazek(strCestaSouborObrazek, rngOblastObrazek, True, _
True, False)

End Sub

Sub VlozitObrazek(ByVal strSouborObrazek As String, ByVal rngOblastVlozeni As _
Range, Optional ByVal bNaStredVodorovne As Boolean = False, Optional ByVal _
bNaStredSvisle As Boolean = False, Optional ByVal bZvetsitMensi As Boolean = _
False)

Dim objObrazek As Object
Dim dOblastShora As Double
Dim dOblastZleva As Double
Dim dOblastSirka As Double
Dim dOblastVyska As Double
Dim dObrazekSirka As Double
Dim dObrazekVyska As Double
Dim dPomerSirky As Double
Dim dPomerVysky As Double
Dim dPomerMax As Double

'zamezení překreslování obrazovky
Application.ScreenUpdating = False

'vložení obrázku
Set objObrazek = ActiveSheet.Pictures.Insert(strSouborObrazek & ".jpg")
'rozměry oblasti pro vložení
With rngOblastVlozeni
dOblastShora = .Top
dOblastZleva = .Left
dOblastSirka = .Width
dOblastVyska = .Height
End With

'původní rozměry obrázku
With objObrazek
dObrazekSirka = .Width
dObrazekVyska = .Height
End With

'maximální poměr (převrácená hodnota měřítka)
dPomerSirky = dObrazekSirka / dOblastSirka
dPomerVysky = dObrazekVyska / dOblastVyska
dPomerMax = WorksheetFunction.Max(dPomerSirky, dPomerVysky)

'je potřeba obrázek zmenšit nebo je požadováno
'zvětšení malých obrázků do velikosti oblasti?
'poměr stran zachován vždy
If (dPomerMax > 1) Or (bZvetsitMensi = True) Then
'zmenšení (zvětšení)
dSirka = dObrazekSirka / dPomerMax
dVyska = dObrazekVyska / dPomerMax
Else
'ponechání rozměrů
dSirka = dObrazekSirka
dVyska = dObrazekVyska
End If

dShora = dOblastShora
dZleva = dOblastZleva

'vodorovné vycentrování?
If bNaStredVodorovne Then
dZleva = dZleva + dOblastSirka / 10 - dSirka / 10
End If

'svislé vycentrování?
If bNaStredSvisle Then
dShora = dShora + dOblastVyska / 10 - dVyska / 10
End If

'nastavení obrázku
With objObrazek
.Top = dShora
.Left = dZleva
.Width = dSirka
.Height = dVyska
End With

'odstranění proměnné z paměti
Set objObrazek = Nothing

'překreslení obrazovky
Application.ScreenUpdating = True

End Sub

Sub OblastSmazatObjekty(ByVal rngOblast As Range)

Dim shpObjekt As Shape

With rngOblast.Parent

'pro každý objekt kolekce Shapes na listu
For Each shpObjekt In .Shapes

'jestliže horní levý roh objektu leží v oblasti
If Not Application.Intersect(shpObjekt.TopLeftCell, rngOblast) Is _
Nothing Then
'a je-li objekt typu obrázek
If (shpObjekt.Type = msoPicture) Or (shpObjekt.Type = _
msoLinkedPicture) Then
'odstranění obrázku
shpObjekt.Delete
End If
End If

Next shpObjekt

End With

End Sub

Děkuji

Dobrý den,
Mě to nefunguje.
Můžete mi prosím poslat přílohu.

Děkuji

Dobrý den,
chtěl bych se zeptat mám kód:

Sub seznam()

Dim FSO As Object
Dim NalezenoF As Long
Dim NalezenoS As Long

Set FSO = CreateObject("Scripting.fileSystemObject")
Set START = FSO.getfolder(Range("C1"))
Set Subfold = START.subfolders

For Each f In START.subfolders
For Each soubor In f.Files
On Error Resume Next
NalezenoF = Range("a:a").Find(what:=soubor.Name, lookat:=xlWhole).Row
If Err.Number = 91 Then
Cells(Cells(65000, 1).End(xlUp).Row + 1, 1) = soubor.Name
End If
On Error GoTo 0
Next soubor
Next f

For Each s In START.Files
On Error Resume Next
NalezenoS = Range("a:a").Find(what:=s.Name, lookat:=xlWhole).Row
If Err.Number = 91 Then
Cells(Cells(65000, 1).End(xlUp).Row + 1, 1) = s.Name
End If
On Error GoTo 0
Next s

End Sub

A potřebuji, aby to vyhledalo soubory jen .jpg

A za druhé, aby to vyhledalo a nezobrazovalo to koncovky .jpg , .docx apod...

Moc Vám děkuji

To jsem udělal, ale nejde nefunguje mi to.

Je možné, aby to vypsalo názvy co jsou ve složce a podsložkách jen fotky jpg. od B2:B10000.

A zobrazovalo to fotky i ty co jsou v podsložkách.
např.:
složka 01 Rodina
podsložky:
001 Rodina
002 Naši mazlíčci
APOD...

a v dané podsložce jsou fotky.

Děkuji

Dobrý den, měl bych prozbu ohledně zobrazení obrázku.

1 ve složce jsou obrázky a sesit Excel když kliknu na daný obrázek tak by se měl zobrazit zobrazí ze pokud je za názvem .jpg je možné to odstranit, aby to zobrazilo obrázek bez koncovky .jmg.

2 Je možné, aby ve sloupečku B2 až B1000 se automatycky načetl sezna v dané složce.

3 sešit musí být v aktuální složce, kde jsou obrázky je možné to upravit tak, aby to bylo na ploše a našetlo to obrázky například ze složky: G:\Mati\001 ODB\001 Imdb\005 Fotky a jsou tam další podsložky

Děkuji za Vaši pomoc

Mám v Acessu bez mála 500 klientů.
Abych dával jednomu po druhém čároví kód jednoduší je když se automatycky z rodného čísla čároví kód vyheneruje u každého.

Já to nezadávám mimo Access je to přímo v Accesu.
Listt mi to vytiskne přímo v Accessu a k tomu potřebuji ten čároví kód.

Děkuji

Dobrý den,
kód na tvorbu čárového v Excelu mám a funguje.
Je to přes Font Code 128.
Ale neumím to aby to šlo v Accessu.

V příloze zasílám vzor na tvorbu čárového kódu v Excelu.

Moc Vás prosím o pomoc.
Děkuji

Dobrý den,
chtěl bych poradit, jak mohu v programu v Accessu vložit čárový kód.

Potřebuji, aby mi to z rodného čísla vygenerovalo čárový kód bohužel potřebuji to v Accessu.
Což si nevím rady.

Předem Vám děkuji za pomoc.

Dobře děkuji ti za tvoji pomoc.

Font mám nainstalovaní, ale čtečka po vitisknutí mi to nepřečte.

Ano aby se to přenastavilo na 0, aby to bylo prázdné.
Učel platby, cena bez DPH, aby se vymazalo, aby to bylo prázdné.

Uživatelské menu

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse