Příspěvky uživatele


< návrat zpět

Strana:  1 ... « předchozí  4 5 6 7 8 9 10 11 12   další » ... 15

Stalker napsal/a:

Nic lepšího mě nenapadlo, ale je to funkční.
Možná někdo přijde s jednodušším řešením.
Otestuj.Příloha: 50303_stop.rar (37kB, staženo 2x)


Mrknu na to zítra v práci, ale každopádně děkuji za ochotu, už se mi podařilo v práci něco "spachtit", ale není to 1OOprocentní..

Akurát to nemůžu formátovat jako tabulku, jelikož to bude sdílený soubor

Zdravím,
potřeboval bych poradit, už si nad tím lámu delší dobu hlavu..

Mám v listu STOP data ( které vkládám makrem ze serveru ), které bych chtěl překopírovat do listu STOPS, ale tak, aby se smazaly duplicitní řádky, ale před tím, když najde ve sloupci "I" stejné číslo chyby , aby sečetlo dané řádky ve sloupci "F" viz přiložený dokument..

list STOP má někdy i 1000 řádků a proto bych to chtěl trochu zredukovat v listu STOPS

Děkuji všem, kteří mě nakopnou nebo pomůžou

Tak vyřešeno s trouchou html 1
dík elninoslov za insipraci 1 1

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 CC As String
Dim ExcelCells As Range
Dim HTML As String
Dim CellsImage As String, tempCellsFile As String
Dim answer As Integer
Dim adresat As String, vec As String, shift1 As String, shift2 As String, shift3 As String, shiftall As String

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


If answer = vbYes Then

shift1 = Range("F12").Value2
shift1 = Format(shift1, "0.00%")
shift2 = Range("K12").Value
shift2 = Format(shift2, "0.00%")
'shift3 = Range("N12").Value 'PRO 3 SMENY
'shift3 = Format(shift3, "0.00%") 'PRO 3 SMENY
shiftall = Range("X3").Value
shiftall = Format(shiftall, "0.00%")

vec = "Report smeny - (" & Range("U2").Value & ") -" & Range("R2").Value & " Denní: " & shift1 & " / Nocní " & shift2 & " / Total: " & shiftall

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Active = ActiveSheet.Name
Set ExcelCells = ThisWorkbook.Worksheets(Active).Range("A1:X150") 'range includes cells and charts
adresat = "email@email.cz"

CC = "email@email.com"


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 & "<img src='cid:" & CellsImage & "'>"
HTML = HTML & "</html>"

Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application
Set OutMail = OutApp.CreateItem(0) 'olMailItem

'Create the email

With OutMail
.To = adresat
.CC = CC
.Subject = vec

'Attach the file referenced in the img tag

Set OutAttachment = .Attachments.Add(tempCellsFile)
Set OutPropertyAcc = OutAttachment.PropertyAccessor
OutPropertyAcc.SetProperty PR_ATTACH_CONTENT_ID, CellsImage

.HTMLBody = HTML

.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)

'Save a picture of an object as a JPG/JPEG file

'Arguments
'saveObject - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
'imageFileName - the .jpg or .jpeg file name (including folder path if required) the picture will be saved as

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

Zdravím,
chtěl bych se zeptat mám kód, který funguje perfektně, ale při zobrazení na telefonu to při přiblížení převrátí bílou za černou viz. obr( mám dojem, že to dělá .png formát ) nevíte jak by to šlo dát do .jpg nebo poradit, aby to neudělalo ?

Děkuji moc za jakoukoliv radu
Sub mailAscreen()

Dim answer As Integer, RNG As Range, PIC As Picture, OUT As Object, OUTMAIL As Object, WRDDOC As Object, adresat As String, vec As String, shift1 As String, shift2 As String, shift3 As String, shiftall As String

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

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

Active = ActiveSheet.Name
With Worksheets(Active)
adresat = "email@email.com"
vec = "Report smeny - (" & .Range("U2").Value & ") -" & .Range("R2").Value & " Denní: " & shift1 & " / Nocní " & shift2 & " / Total: " & shiftall

Set RNG = Range("A1:X150")
RNG.Copy
Set PIC = ActiveSheet.Pictures.Paste
PIC.Cut

Set OUT = CreateObject("Outlook.Application")
Set OUTMAIL = OUT.CreateItem(olMailItem)
With OUTMAIL

.To = adresat
.CC = "email@email2.com"
.Subject = vec

End With
OUTMAIL.Display
Set WRDDOC = OUTMAIL.GetInspector.WordEditor

WRDDOC.Range.Application.Selection.Paste
'MsgBox "Email odeslán!", vbCritical
End With

Else
End If
Beep
End Sub

Lugr napsal/a:

Zkuste:

Soubor -> Možnosti -> Upřesnit -> Možnosti úprav->[✓] Povolit operace přetažení úchytem a přetažení buňky


Děkuji mockrát
jsem hned napsal dík, ale nějak jsem to asi neodeslal 1

Já to mám taky problém mezi mnou a klávesnicí a nemůžu na to přijít.. celou dobu to fungovalo a nejde to roztáhnout..

Omlouvám se za delší kód 7

Hola Hekři 1 ,
Chci se zeptat mám kód:
,ale když už je SAP spuštěn tak mi to hodí error. Chtěl bych, když je spuštěn, tak ať to pokračuje dál kódem
Dim Appl As Object
Dim Connection As Object
Dim session As Object
Dim WshShell As Object
Dim SapGui As Object

LS24_text = Range("B2").text
Login = Range("H1").text
Passwd = Range("H2").text

'Of course change for your file directory
Shell "C:\Program Files\SAP\FrontEnd\SAPgui\saplogon.exe", 1
Set WshShell = CreateObject("WScript.Shell")

Do Until WshShell.AppActivate("SAP Logon ")
Application.Wait Now + TimeValue("0:00:01")
Loop

Set WshShell = Nothing

Set SapGui = GetObject("SAPGUI")
Set Appl = SapGui.GetScriptingEngine
Set Connection = Appl.OpenConnection("01 - PRD WINTEL")
Set session = Connection.Children(0)
'session.ActiveWindow.Iconify
'if You need to pass username and password
session.findById("wnd[0]/usr/txtRSYST-MANDT").text = "300"
session.findById("wnd[0]/usr/txtRSYST-BNAME").text = Login
session.findById("wnd[0]/usr/pwdRSYST-BCODE").text = Passwd
session.findById("wnd[0]/usr/txtRSYST-LANGU").text = "CS"

If session.Children.Count > 1 Then

answer = MsgBox("You've got opened SAP already," & _
"please leave and try again", vbOKOnly, "Opened SAP")

session.findById("wnd[1]/usr/radMULTI_LOGON_OPT3").Select
session.findById("wnd[1]/tbar[0]/btn[0]").press

Exit Sub

session.findById("wnd[0]").maximize
session.findById("wnd[0]").sendVKey 0 'ENTER
session.findById("wnd[0]/tbar[0]/okcd").text = "LS24"
session.findById("wnd[0]").sendVKey 0

End If

Děkuji mnohokrát

Po mnoha letech...

A když se jedná o UF ? nevíte někdo ?

Díky

Konkrétnější příklad by nebyl?

elninoslov napsal/a:

Nepíšete, čo sa má s tým diať. Uložiť do listu? Na disk? Do mailu? Ak si dáte do Googlu výraz "vba form screenshot" nájdete väčšinou API, no tento kratučký stačí na screenshot do listu:
Private Sub CommandButton1_Click()
Application.SendKeys "(%{1068})"
DoEvents
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
End Sub


Díky stačilo mi nakonec jen

Application.SendKeys "(%{1068})"

1

Zadaval jsem snad vsechno do googlu ale screenshot me nenapadl 1 dekuji mrknu na to vecer v práci..

Zdravím,
jen se chci zeptat jestli jde přes button vyfotografovat aktivní form. Nevíte někdo jestli to jde udělat ?

např.

Díky za jakýkoliv nápad či návrh.


Strana:  1 ... « předchozí  4 5 6 7 8 9 10 11 12   další » ... 15

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

On-line nástroje