Příspěvky uživatele
< návrat zpět
€Ł мσşqμΐτσ napsal/a:
tak trochu jsem to ještě předělal.
nevím přesné čím to může být. Možná zdrojové sešity nemají vždy jenom jeden list, nebo ne vždy se jmenují "Sheet0".
pokud ani teď to nebude fungovat budu potřebovat víc těch sešitů k porovnáni čím se od sebe liší. minimálně ty soubory u kterých vám to nefungujePříloha:
51950_test.zip (41kB, staženo 0x)
Vždy se jmenuje sheet0 a je tam jen jeden
Anonym napsal/a:
děkuji
Nemáš zac..
Aspoň jsem zavzpomínal na časy před 20lety :-)
Kdy jsem dělal internetove stránky v poznámkovém bloku
€Ł мσşqμΐτσ napsal/a:
tak koukám mně to doma taky nefungovalo
jenom připomenu , že složka kterou jste poslal je pojmenovaná jako "Download", kde v příkazu jste měl "Downloads", takže teď nevím které je správně.
upravit když tak cestu v řadku viz níže pak už snad bude dobrý
z
cestaSesitu = "C:\Users\OVRotating\Downloads\" & Dir(Sesit)
na
cestaSesitu = "C:\Users\OVRotating\Downloads\" & Dir("C:\Users\OVRotating\Downloads\" & Sesit)
Tak todle pomohlo částečne.
Správně se otevřou soubory ale data se nezkopírují.
Když odstraním: nactenySesit.Close False
tak zůstanou aspoň sešity otevřené, ale listy jsou prázdné
€Ł мσşqμΐτσ napsal/a:
Přidal jsem nové tlačítko s novým makrem.
Pokud bude pokaždé jenom jeden soubor od každého sešitu ve složce "Download" tak by to mělo fungovat.
Ale, pokud se tam průběžné přidávají další s novým datumem a časem, tak to bude chtít řešit jinak. Někde se do sešitu bude muset ukládat názvy posledných kopírovaných souborů, aby makro vědělo které soubory již byly zkopírované. Pak je otázka jestli před kopírováním mazat již uložená data nebo je kopírovat pod ně.Příloha: 51924_test.zip (40kB, staženo 1x)
Zdravím,
nějak mi to nechce najít ty soubory vypíše mi to ten MsgBox nenalezeno
no pokaždé tam bude pouze jeden soubor s tímto názvem, který chci po dokončení makra vymazat (kill)
Ale vypadá to nadějně, tak nějak jsem to chtěl
€Ł мσşqμΐτσ napsal/a:
Zdravím,
nevím jestli jsem správně pochopil zadání, mám pár otázek.
- všechny soubory které chcete otevřít máte v jedné složce? "C:\Users\OVRotating\Downloads"
- chcete načíst všechny soubory z této složky od poslední, která byla už načtena, nebo vždy jenom jeden soubor?
- v jakém tvaru je ten den a čas?
- je možnost sem hodit nějaký demo sešit klidně bez dat abych mohl makro upravit?
děkuji
Všechny soubory jsou v jedné složce
soubory vždy začínají:
stops_XXXXX.xls
perfomance_detail_XXXXX.xls
klidně to může být na 1 tlačítko, aby to udělalo vše naráz, ale ještě to chce ošetřit když nenajde ten subor nějak..
https://uloz.to/tamhle/jeCOlRfk2I8U/name/Nahrano-18-1-2022-v-14-33-22#!ZGywAwR2AGqwLzH1AmD1LzSyAQIvMSH4FGWnqTE1MRE5rGV3AN==
Anonym napsal/a:
...aha. diky. Kdyz zadna prijemnejsi varianta neni.
..stacilo by aspon nejaky prikaz na ukonceni radku.
ukončení řádku v html kódu je: <br>
<h1>velké písmo</h1> je velký nadpis podle čísla ubíráte velikost
<b>tučně</b>
<i>kurzíva</i>
<u>podtržený text</u>
atd... víc google
Zdravím,
chtěl bych se zeptat, jestli někdo neví jak lze otevřít jiný .xls a nahrát data do původního.
Momentálně to řeším přes:
Application.FileDialog(msoFileDialogFilePicker)
, ale chtěl bych, aby to otevřelo pokaždé soubor s názvem:
"stops_XXXXXXXXXXX_XXXXXXXX.xls" (v X je obsaženo den a čas stáhnutí souboru, ale je pokaždé jiný.
Díky za jakokoliv radu
Teď mám kód:
Active = ActiveSheet.Name
With Application.FileDialog(msoFileDialogFilePicker) 'spustí dialogové okno pro otevření
.InitialFileName = "C:\Users\OVRotating\Downloads" 'nastavení úvodní složky procházení
.Title = "Vyber adresár" 'nastavení názvu okna
.Filters.Add "Stáhnuté poruchy z reportu (xls)", "*.xls*", 1 'nastavení filtru pro zobrazení souborů
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Nebyly nacteny žádné soubory!", vbExclamation: Exit Sub 'pokud není vybrán žádný soubor, makro vypíše hlášení a ukončí se
Application.ScreenUpdating = True
Sheets(Active).Select
Range("A1").Select
ElseIf .SelectedItems.Count > 1 Then
MsgBox "Vyberte pouze jeden soubor!", vbExclamation: Exit Sub 'pokud je vybráno více, než jeden soubor, makro vypíše hlášení a ukončí se
Application.ScreenUpdating = True
Sheets(Active).Select
Range("A1").Select
Else
zdrojovy_soubor = .SelectedItems(1) ' načte adresu souboru do proměnné
End If
End With
Workbooks.Open (zdrojovy_soubor) ' otevření souboru, který jsme vybrali
For Each List In Sheets
Range("H2:H1200").Select
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
docasna = List.Range("A2:O1200")
Pokud data z emailu nekopíruješ tak to jde vložit přes JPG
Sub mailAscreen()
Dim OutApp As Object 'Outlook.Application
Dim OutMail As Object 'Outlook.MailItem
Dim OutAttachment As Object 'Outlook.Attachment
Dim OutPropertyAcc As Object 'Outlook.PropertyAccessor
Dim SendTo As String
Dim CC As String
Dim Subject As String
Dim ExcelCells As Range
Dim HTML As String
Dim CellsImage As String, tempCellsFile As String
Dim answer As Integer
answer = MsgBox("Opravdu chceš odeslat email?", vbQuestion + vbYesNo + vbDefaultButton2, "Opravdu chceš odeslat email?")
If answer = vbYes Then
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Active = ActiveSheet.Name
Set ExcelCells = ThisWorkbook.Worksheets(Active).Range("A1:AC152")
SendTo = "email@email.com"
Subject = "Předmět emailu"
CellsImage = Replace(Timer, ".", "") & "image.jpg"
tempCellsFile = Environ("temp") & "\" & CellsImage
Save_Object_As_Picture ExcelCells, tempCellsFile
HTML = "<html>"
'HTML = HTML & "<a href=""http://www.seznam.cz"">seznam.cz</a>"
HTML = HTML & "<img src='cid:" & CellsImage & "'>"
HTML = HTML & "</html>"
Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application
Set OutMail = OutApp.CreateItem(0) 'olMailItem
With OutMail
.To = SendTo
.CC = CC
.Subject = Subject
' pridání prílohy
.Attachments.Add tempCellsFile, olByValue, 1, ""
Set OutAttachment = .Attachments.Add(tempCellsFile)
Set OutPropertyAcc = OutAttachment.PropertyAccessor
OutPropertyAcc.SetProperty PR_ATTACH_CONTENT_ID, CellsImage
.HTMLBody = HTML
' .send
.Display
End With
'Delete the temporary image file
Kill tempCellsFile
Set OutMail = Nothing
Set OutApp = Nothing
End If
End Sub
Private Sub Save_Object_As_Picture(saveObject As Object, imageFileName As String)
Dim temporaryChart As ChartObject
Application.ScreenUpdating = False
saveObject.CopyPicture xlScreen, xlPicture
Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
With temporaryChart
.Activate
.Border.LineStyle = xlLineStyleNone 'No border
.Chart.Paste
.Chart.Export imageFileName
.Delete
End With
Application.ScreenUpdating = True
Set temporaryChart = Nothing
End Sub
+ to odešle JPG jako přílohu
StrejdaPompo napsal/a:
Ano, určitě to jde.
Už jsem na to přišel:
Option Explicit
Private Declare PtrSafe Function GetSystemMenu Lib "USER32" _
(ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare PtrSafe Function RemoveMenu Lib "USER32" _
(ByVal hme2nu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "USER32" _
(ByVal lpClassName2 As String, _
ByVal lpWindowName2 As String) As Long
Private Const MF_BYPOSITION As Long = &H400
Public Sub FormatUserForm(UserFormCaption As String)
Dim lFrmHdl As Long
Dim iCount As Integer
lFrmHdl = FindWindowA(vbNullString, UserFormCaption)
If lFrmHdl <> 0 Then
For iCount = 0 To 1
RemoveMenu GetSystemMenu(lFrmHdl, False), 0, MF_BYPOSITION
Next iCount
End If
End Sub
a pak
Call FormatUserForm(Me.Caption)
Zdravím,
u této části mi to zežloutne a napíše chybu:
Hodnota = Replace(sHodnota & ":00", "h", ":")
RunTime Error 13
Ale když to mám u tebe v souboru tak to jede, jen to překopíruji do mého a tam to hodí chybu 
Zdravím,
jde zamknout pozici, aby sní nešlo hýbat?
Dík
elninoslov napsal/a:
https://stackoverflow.com/questions/48562941/closing-any-open-userform
Dík jsem zkoušel dost takových kodu, které jsem našel, ale tady tenhle jsem nevyzkoušel.
Ještě jednou díky
elninoslov napsal/a:
Stačí vytvoriť novú premennú "sviatky" ale pre celý zošit. Starú lokálnu zmazať.
jak to udělat ? to neznám on má udělané měsíce, ale jak to udělat ani ja nevim :( ja vzdy odkazuji na konkretní bunky
elninoslov napsal/a:
Tipujem, že je to pre to, lebo "sviatky" je lokálny Definovaný názov pre list NEMAZAT. Nie pre celý zošit
Přesně tak: =MATCH($A4;NEMAZAT!$C$5:$C$20;0)
Zdravím,
jak můžu zavřít všechny formy najednou tlačítkem?
Mám kód u jednoho formu, že nelze zavřít a potřebuji dodat tlačítko s heslem pro zavření všech formů. (heslo zvládnu, ale potřebuji všechny formy zavřít)
Díky za jakékoliv info
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články