Příspěvky uživatele

Zdravím,

potřeboval bych pomoct při zobrazení jedinečných hodnot a u poslední hodnoty, aby to vypsalo datum a čas z jiného sloupce.

Děkuji za jakoukoliv radu.

To bylo velké nakopnutí...

Díky zítra vyzkouším, ale jak Vás znám tak to bude fungovat perfektně.

Ještě jednou díky

Podmíněné formátování
Dát si vlastní podmínku např. =A1>0. Pro zelenou a pro červenou- =A1<0

Zdravím,

Nevíte náhodou jak můžu smazat všechny listy začínající vždy na 0? Mám listy např. 01.09.2023, 02.09.2023..... a potřeboval bych vždy na konci měsíce tyto listy smazat.

Děkuji za jakékoliv nakopnutí.

Díky

Zdravím mám makro:
Sub SaveMyFile()
ActiveWorkbook.SaveCopyAs Filename:="\\Fantasyk\Report_2023_autosave.xlsm"
Call Timer_auto
End Sub

Sub Timer_auto()
Const MINUTES As String = "45"
Application.OnTime Now() + TimeValue("00:" & MINUTES & ":00"), "SaveMyFile"
End Sub

Které mi každých 45minut uloží kopii na server, ale problém je v tom, že když někdo nebo já nechám otevřený jiný excel soubor a nechám ho aktivní, tak se mi v daný čas spustí makro jak má, ale uloží to aktuální zobrazený excel soubor místo toho původního.

Nevíte jak by to šlo ošetřit, aby to vždy uložilo jen ten soubor, ve kterém je makro?
PS: soubor, který chci uložit je proměnný, ale vždy začíná "Report_" a končí.xlsm

Díky za jakokoliv radu

Tak jsem to udělal následovně:

ThisWorkbook:
Private Sub Workbook_Open()
Const MINUTES As String = "01"
Application.OnTime Now() + TimeValue("00:" & MINUTES & ":00"), "SaveMyFile"
End Sub

Modul1:
Sub SaveMyFile()
ActiveWorkbook.SaveCopyAs Filename:="C:\Users\Zaloha\autosave.xlsm"
Call Timer
End Sub

Sub Timer()
Const MINUTES As String = "01"
Application.OnTime Now() + TimeValue("00:" & MINUTES & ":00"), "SaveMyFile"
End Sub

čas 01 byl jen pro test..

To jsem před tím taky našel, ale nějak mi to nefunguje tak jak bych si to představoval.
Při otevření sešitu bude běžet interval např. 30 minut a každých 30 minut se mi soubor uloží jako kopie na disk C:\Users\NOOB\desktop\zaloha.xlsm
,Ale zůstane aktivní stále ten původní soubor.

Abych mohl v případě pádu ihned zareagovat a otevřít tu kopii

Zdravím,
Chtěl bych ve VBA vytvořit makro, aby mi ukládalo kopii aktuálního sešitu na určité místo. ( C:\Users\NOOB\desktop\zaloha.xlsm )
Sešit je otevřený non-stop a v intervalu 2 hodin, bych potřeboval přepisovat soubor "zaloha.xlsm", abych měl zálohu v případě pádu.

Díky za jakýkoliv typ

Zdravím,
potřeboval bych poradit s přidáním více příloh do emailu.

Mám makro ve kterém posílám z listu "active" to mi funguje, ale potřeboval bych posílat ještě jeden soubor se stejnou Range, ale z listu REPORT_EN

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 ExcelCells_EN As Range
Dim HTML As String
Dim CellsImage As String, tempCellsFile As String
Dim answer As Integer
Dim shift1 As String
Dim shift2 As String
Dim shiftall As String

answer = MsgBox("Opravdu chceš odeslat report smeny?", vbQuestion + vbYesNo + vbDefaultButton2, "Odeslání Reportu smeny")

If answer = vbYes Then

On Error GoTo bugy

Range("T11").Comment.Visible = True
Range("T11").Comment.Shape.Select True
Selection.ShapeRange.IncrementLeft -12#
Selection.ShapeRange.IncrementTop -145.25
bugy:

On Error GoTo bugy2
Range("L11").Comment.Visible = True
Range("L11").Comment.Shape.Select True
Selection.ShapeRange.IncrementLeft -12#
Selection.ShapeRange.IncrementTop -145.25

bugy2:

shift1 = Range("F12").Value2
shift1 = Format(shift1, "0.00%")
shift2 = Range("N12").Value
shift2 = Format(shift2, "0.00%")
shiftall = Range("AE3").Value
shiftall = Format(shiftall, "0.00%")

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Active = ActiveSheet.Name
Set ExcelCells = ThisWorkbook.Worksheets(Active).Range("A1:AF166") 'range includes cells and charts
Set ExcelCells_EN = ThisWorkbook.Worksheets("REPORT_EN").Range("A1:AF166") 'range includes cells and charts
SendTo = "ahoj@ahoj.com"
CC = "hello@hello.com"
Subject = "Report smeny - (" & Range("AA2").Value & ") -" & Range("V2").Value & " Denní: " & shift1 & " / Nocní " & shift2 & " / Total: " & shiftall

CellsImage = Replace(Timer, ".", "") & "image.jpg"

tempCellsFile = Environ("temp") & "\" & CellsImage

Save_Object_As_Picture ExcelCells, tempCellsFile

'Construct email body as HTML string, with the range image in an img tag with corresponding src='cid:xxxx.jpg' attribute

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

For Each C In ActiveSheet.Comments
C.Visible = False
Next

ThisWorkbook.Application.Caption = " poslední odeslaný report: " & Date & " - " & Time

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

Díky za radu

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje