Příspěvky uživatele


< návrat zpět

Strana:  1 ... « předchozí  4 5 6 7 8 9 10 11 12   další » ... 15
Převod každého znaku na jiný podle předlohy (21.4.2021 17:32)

Zdravím,
chtěl bych se zeptat, jestli lze číslu přiřadit každému číslu jiný znak nebo jiné číslo.

Vzor s převodem mám v příloze.

Děkuji za jakékoliv nakopnutí 1

Opakované použití textboxu (18.4.2021 22:19)

tzv. aby to udělalo záznam při načtení ID karty a vyprázdnilo to textbox.
Poprvé to udělá a podruhé už to nic neudělá 7

sčítání podle kritérií (18.4.2021 3:37)

opravdu nejblbější řešení 5, ale funguje 5 5 5

Opakované použití textboxu (18.4.2021 2:35)

Hoj Hekři 1 ,

řeším takový problémek :
Když zkopírujete nějaké ID např. "12345678" a kliknete na tlačítko "Přidat záznam" a vložíte do pole "Naskenovat ID kartu..." tak se správně vloží záznam, ale problém je v tom, že to bude připojené k čtečce karet a chtěl bych, aby to fungovalo opakovaně, ale nedaří se mi to zprovoznit 8

Díky za jakoukoliv radu

VBA změnit barvu textu (4.4.2021 7:00)

elninoslov jsi jednička s milionem hvězdiček

VBA změnit barvu textu (3.4.2021 17:25)

No teď mě napadlo, že to vždy končí "min" , ale jak to tam implementovat

VBA změnit barvu textu (3.4.2021 16:57)

Zdravím,
chtěl bych se zeptat, jestli lze makrem vyhledat určený text a přebarvit ho ?

Např.:
Nezapsané prostoje- 1h47min, NOK stanice - 1h4min,
Přechod - změna MIX/UL- 11min, MIX Váha - šnek / Vibrátor- 32min, Start-up / Čekání na Start-up - měření teplot- 11min,

a přebarvit část textu např. Nezapsané prostoje- 1h47min
, ale ten čas je pokaždé jiný..

tzv. kliknu na tlačítko a pokud najde Nezapsané prostoje + časy v některých buňkách tak je přebarví na červenou

Mám udělané zatím tohle:

Set myRange = Range("A1:A100")
substr = "Nezapsané prostoje-"
txtColor = 3

For Each myString In myRange
lenstr = Len(myString)
lensubstr = Len(substr)
For i = 1 To lenstr
tempString = Mid(myString, i, lensubstr)
If tempString = substr Then
myString.Characters(Start:=i, Length:=lensubstr).Font.ColorIndex = txtColor
End If
Next i
Next myString

, ale nevím jak přidat ten čas který se mění 8

Díky za radu

Kopírování do jiného listu - s podmínkami (3.4.2021 14:17)

Děkuji moc

VBA - Method Add of object ChartObjects failed (3.4.2021 8:22)

Zdravím,
Nesetkal jste se někdo s touhle chybou ?

Run-time error'-2147417878 (80010108)': Method 'Add' of object 'ChartObjects' failed

Zobrazí se jen tehdy, když dám soubor na síť a sdílím ho a jen u tlačítka, které posílá email..

Dík za jakoukoliv radu

Kopírování do jiného listu - s podmínkami (3.4.2021 7:38)

funguje přesně jak má jsi šikula ( tohle bych makrem jak to máš nikdy nedal ).

Problém nastane tehdy, když tam je 1000 řádků trvá to strašně dlouho, tak jsem to udělal nakonec takto:

přidal jsem další sloupec:
=SUMIFS($F2:F$2000;$B2:B$2000;B2;$I2:I$2000;I2))
a nakopíroval dolů..

tím pádem mi to sečetlo časy daných chyb.
a pak jsem smazal duplicitní hodnoty


Sheets("STOPS").Select
Columns("A:AA").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("STOP").Select
Columns("A:AA").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$AA$1998").RemoveDuplicates Columns:=Array(2, 3, 9, 10, _
11, 22), Header:=xlYes

pracuje to mnohem rychleji, jen tam je ten sloupec navíc.. ( a jen mi trvalo asi 10 hodin na to přijít 9 )

Ale děkuji mockrát za ochotu

Kopírování do jiného listu - s podmínkami (2.4.2021 19:50)

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

Kopírování do jiného listu - s podmínkami (2.4.2021 9:21)

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

Kopírování do jiného listu - s podmínkami (2.4.2021 9:08)

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

Odeslání obrázku v mailu v JPG formátu -VYŘEŠENO (11.3.2021 2:57)

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

Odeslání obrázku v mailu v JPG formátu -VYŘEŠENO (10.3.2021 23:36)

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


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