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

Příspěvky uživatele

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

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

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse