Příspěvky uživatele
< návrat zpět
Váš problém vyriešia zástupne znaky, konkrétne "*" Ak zadáte "*a" odfiltruje vám presne to čo požadujete.
Ak to nechcete písať ručne doplní to makro. Viz. príloha.
Pred nedávnom som riešil podobný problém. Vyriešené pomocou Windows API. Možno pomôže.
- Win7 32, 64
- Cesta nesmie obsahovať medzery!
Option Explicit
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim sMusicFile As String
Dim Play
Sub Sound() 'prehraje zvuk
sMusicFile = ThisWorkbook.Path & "\zvuk.mp3"
Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
End Sub
Sub StopSound() 'zastavi aktualne spusteny zvuk.
Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub
Jeza.m napsal/a:
Jen k tomu druhému, proč ne jen
MsgBox Application.Caller
Samozrejme aj tak sa dá. Na celom je dôležite práve to "Application.Caller" Milan26 chce názov labelu, predpokladám že ho ma v plane ďalej použivať v kóde tak som to dal do premennej.
Ako to použije je už len na ňom, bola to len ukážka toho že je jeho požiadavok reálny.
Ano, da. Ak ide o UserForm tak takto:
Private Sub Label1_Click()
Call Spustane_Macro(Label1.Caption)
End Sub
Sub Spustane_Macro(Nazov As String)
MsgBox Nazov
End Sub
...ak o shape, tak takto:
Sub Shape_Click()
Call Spustane_Macro(Application.Caller)
End Sub
Sub Spustane_Macro(Nazov As String)
MsgBox Nazov
End Sub
Myslím že takto by to mohlo stačiť. Poprípade si to upravte.
Sub Export_Ako_PNG()
Dim List As Object, Graf As Object
Dim NazObr As String, NazList As String
Dim ObrH As Single, ObrW As Single
Dim Cesta As String, Nazov As String
Application.ScreenUpdating = False
NazList = "CELKEM"
Set List = Sheets(NazList)
With List
.Select
Nazov = .Range("A1").Text & ".PNG" 'nazov obrazku
Cesta = .Range("AM1").Text & "\" 'kam sa ma ulozit obrazok
.Range("A2:U40").Copy 'oblast ktora sa ma ulozit
.Pictures.Paste.Select
End With
NazObr = Selection.Name
With Selection
ObrH = .ShapeRange.Height
ObrW = .ShapeRange.Width
End With
List.Cells(1, Columns.Count).Select
Set Graf = List.ChartObjects.Add(10, 10, ObrW, ObrH).Chart
With Graf
.Parent.Border.LineStyle = 0
List.Shapes(NazObr).Copy
.ChartArea.Select
.Paste
.Export Filename:=Cesta & Nazov, FilterName:="PNG"
.Parent.Delete
End With
List.Shapes(NazObr).Delete
Application.ScreenUpdating = True
End Sub
Chyba bude niekde inde. Obe kúsky kódu robia presne to čo ste požadoval. Jeden kopíruje všetko a druhy len hodnoty. (xlPasteValues)
Bude to chcieť lepšiu prílohu, tato je pravdepodobne nedostatočná.
...takto
Sub kopiruj()
Dim Radek As Long
Dim wsData As Worksheet
Dim wsHist As Worksheet
Set wsData = Worksheets("Data")
Set wsHist = Worksheets("Historie dat")
Radek = wsHist.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsData.Range(Cells(2, 1), Cells(2, 8)).Copy
wsHist.Cells(Radek, 1).PasteSpecial Paste:=xlPasteValues
wsData.Range(Cells(2, 1), Cells(2, 8)).ClearContents
End Sub
=CONCATENATE(TEXT(M32;"h:mm:ss");" hodin")
Na menej to nedám. Keď sa ale berie cyklus ako jeden riadok tak by to mohlo byť správne. 
For s = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If Cells(1, s).Value = 10 Then Cells(s).EntireColumn.Delete
Next s
Macro som písal v noci a zabudol som na par "múch". Už sú opravené.
Určite sa to zíde viacerým vrátane mňa. Upravte si oblasť, cestu a názvy obrázkov.
Sub Ulozit_Ako_PNG()
Dim Graf As Chart
Dim NazObr As String, NazList As String, NazGra As String
Dim ObrH As Single, ObrW As Single
Dim Cesta As String, Nazov As String
Dim a As Byte, b As Byte
Application.ScreenUpdating = False
a = (99 - 1) * Rnd() + 1
b = (99 - 1) * Rnd() + 1
Nazov = "\Obrazok" & a & b 'nazov obrazku
NazList = ActiveSheet.Name
Cesta = Sheets(NazList).Parent.Path & Nazov & ".PNG" 'kam sa to ma ulozit
NazGra = "GrafX"
Selection.Copy 'oblast ktora sa ma ulozit
Sheets(NazList).Pictures.Paste.Select
NazObr = Selection.Name
With Selection
ObrH = .ShapeRange.Height
ObrW = .ShapeRange.Width
End With
Sheets(NazList).Cells(1, Columns.Count).Select
Set Graf = Charts.Add
Set Graf = Graf.Location(Where:=xlLocationAsObject, Name:=NazList)
With Graf
.Parent.Name = NazGra
.ChartArea.Width = ObrW
.ChartArea.Height = ObrH
.Parent.Border.LineStyle = 0
End With
Sheets(NazList).Shapes(NazObr).Copy
With Graf
.ChartArea.Select
.Paste
.Export Filename:=Cesta, FilterName:="PNG"
End With
With Sheets(NazList)
.ChartObjects(NazGra).Delete
.Shapes(NazObr).Delete
End With
Application.ScreenUpdating = True
End Sub
Napríklad takto?
...zmeň si cestu(teraz sa ukladá obrázok k .xlsm súboru) a oblasť ktorú chceš uložiť ako obrázok.
Už to pracuje jak ma. Veľmi pekne vám ďakujem.
Riešenie od elninoslov je presne to čo som potreboval. Už dávnejšie som skúšal googlit a nepodarilo sa mi rozchodiť ani jedno riešenie. Preto som to spravil okľukou cez VB.NET a pomocnou app. V tej chvíli pre mňa najjednoduchšie riešenie. Nenapadlo ma zájsť sem.
Ešte raz vďaka.
Zdravím.
Chcel by som sa vás opýtať či je možne pomocou VBA stiahnuť súbor z netu.
Mam excel tabuľku ktorá sa pred spustením aktualizuje z CSV súboru. Makro si súbor upraví, použije potrebne dáta a už nepotrebný súbor zmaže. Zatiaľ to riešim mini App ktorú som si napísal v VB.NET. Ta stiahne súbor a spusti tabuľku. Súčasne riešenie je síce funkčne ale...
Pomocou VB.NET to mam riešene viz. obrázok.
Vďaka za radu.
Uživatelské menu
\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