• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Ahoj,

když se jedná jenom o jeden sloupec tak použij makro viz níže a když více sloupců tak by bylo jednodušší poslat přílohu

Private Sub CommandButton1_Click()
'Vložit obrázek do komentáře buňky
Dim sloupec, bunka
Dim Cesta As String
Dim Pripona As String
Dim FileName As String
Dim cmt As Comment
Dim dWidth As Double
Dim dHeight As Double

Cesta = "C:\Users\Mosquito\Desktop\blabla\" 'sem zadat cestu kde se fotky nachází
Pripona = ".jpg" 'sem zadat správnou příponu

sloupec = 1 ' sloupec = císlo sloupce (v tomhle pripade 1 je sloupec A)

For Each bunka In Range(Cells(1, sloupec), Cells(Rows.Count, sloupec).End(xlUp))
If Not bunka = Empty Then
FileName = Cesta & bunka & Pripona
On Error Resume Next
'Zjištění rozměrů obrázku
ActiveSheet.Pictures.Insert(FileName).Select
dWidth = Selection.Width
dHeight = Selection.Height
Selection.Delete

'Vložení obrázku do komentáře

With bunka
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If

With cmt
.Text Text:=""
.Shape.Fill.UserPicture FileName
.Shape.Width = dWidth
.Shape.Height = dHeight
.Visible = False
End With
End With
On Error GoTo 0
End If
Next bunka
End Sub

Ahoj,

jenom jsem trochu zkrátil a upravil zacatek makra

Private Sub CommandButton1_Click()
'Vložit obrázek do komentáře buňky
Dim Cesta As String
Dim Pripona As String
Dim FileName As String
Dim cmt As Comment
Dim dWidth As Double
Dim dHeight As Double

Cesta = "C:\Users\czprsm03\Pictures\" 'sem zadat cestu kde se ta fotka nachází
Pripona = ".jpg" 'sem zadat správnou příponu fotky

FileName = Cesta & ActiveCell & Pripona

'Zjištění rozměrů obrázku
ActiveSheet.Pictures.Insert(FileName).Select
dWidth = Selection.Width
dHeight = Selection.Height
Selection.Delete

'Vložení obrázku do komentáře
On Error Resume Next
With ActiveCell
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If
With cmt
.Text Text:=""
.Shape.Fill.UserPicture FileName
.Shape.Width = dWidth
.Shape.Height = dHeight
.Visible = False
End With
End With

End Sub

ale tohle ti vytváří stále nové grafy.

zkus takhle

Dim oblst As Range
Sub Makro1()

Set oblst = List1.Range("B2:F11")
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData oblst
ActiveChart.ChartType = xlLine
Set oblst = Nothing
End Sub
Sub Makro2()
Set oblst = List1.Range("B2:B11,D2:D11,F2:F11")

ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData oblst
ActiveChart.ChartType = xlLine
Set oblst = Nothing
End Sub

AL:
děkuji ti.
tohle je přesně co potřebuji
já blázen se snažil vzorečkům co nejvíc vyhýbat a řešit všechno vba a teď mám mezery

třeba
Range("A1:A20").NumberFormat = "0"

Kluci děkuji vám za povzbudivé písmenka a za váš čas
na ADO a SQL se určitě podívám.

Palooo: díky za odkazy a přeji příjemně ztrávenou dovolenou

AL: vzorce jsou taky pro mě těžký oříšek

k zadání ještě: vzoreček se mi líbí, ale nedokážu ho upravit tak aby nalezené hodiny byly v rozmezí těch časů.
t.j. když zadám od6:42 do9:48 tak výsledek hledání nemůže být mimo té množiny.
Výsledek u tvého vzoru je 6:40 ( což je špatně když mám od 6:42)
Výsledek u tvého vzoru je 9:50 ( což je špatně když mám do 9:48)

Zdravím pánove,

potřeboval bych nakopnout

mám csv soubory, kde ve sloupci "A" jsou časy (cca 20 tis až 50tis řádku, záleží jaký den vyberu) viz přílohu
mam vytvořený UF pro zadaní času od-do (třeba od 06:00:00 do 10:30:00)

potřeboval bych vymyslet příkaz, které by mi našlo:
řádek nejbližší k času počátečnímu (od) a
řádek nejbližší k času konečnému (do)

příkaz "find" není to pravé ořechové.

Má prosím někdo nějaký nápad?
Nebo to budu muset cyklovat řádek po řádku?

nechápu moc co potřebuješ. píšeš, že chceš jednotky po 100;200;300... ale v tabulce nemas nic takového. podle čeho volíš který člověk do které skupiny. Makro se mi nechctelo krokovat je moc dlouhé
Popíš trochu víc svůj požadavek a dáme to dohromady

Ahoj
tohle zkopíruj do thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim bnk As Variant
Dim r1 As Integer, r2 As Integer

r1 = 20
r2 = 50

For Each bnk In Sh.Range(Cells(1, 1), Cells(1, 20))
If bnk = 0 Or bnk = "" Then
Sh.Rows(r1 & ":" & r2).EntireRow.Hidden = True
Else
Sh.Rows(r1 & ":" & r2).EntireRow.Hidden = False
End If
r1 = r1 + 40
r2 = r2 + 40
Next
End Sub

Makro se spustí při přepínání listů.

takto

Private Sub CommandButton2_Click()
adresar = "C:\User\215781\????\"
ChDir adresar
ActiveWorkbook.SaveAs Filename:="poptavka" & Format(Now, "yyyymmdd") & ".xlsm"
End Sub

Ahoj, udělal jsem makro pro zapisovaní vkladů a výběrů přes tlačítka ( v druhé tabulce) a userform.

Snad ti to trochu pomůže.

Co se týče procent a suma celkem, tam stačí doplnit vzorečky, ale to si snad uděláš sám.
Já v tom zrovna nevynikám.

csá csumi ...

Mám takový pocit, že se složkou $RECYCLE.BIN, která je schovaná.
Ale 100% si nejsem jistý, nijak jsem to nestudoval.
Přidal jsem prikaz On Error Resume Next toď vše

ahoj.
upraveno
+
přidal jsem tlačítko Uložit nové kde:
1) už není dialogové okno (ukládá tam kde se nachází sešit)
2) počet řádků v sešitě je dynamický (uloží všechny řádky)
3) sloupce lze libovolně nastavit (počet, pořadí)
4) místo příkazu Write jsem nahradil Print (ukládání bez uvozovek)

Snad teď už si vybereš a složíš si makro dle obrazu svého

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse