I have a backgroundworker to work on objects and queries, but it calls a delegate to write in a datagridview, but when I add 1 character to the string for the delegate, it no longer writes to the grid and enters the me.invokerequired, if I remove this character it goes to the else.
From here I call the delegate
If jsonElemento.cantidad_errores <> 0 Then
If jsonErrores.Count = 0 Then
vector = fila("docentry").ToString + ";" + fila("tipo") + ";" + " " + "i add the char here (;)" + jsonElemento.cantidad_errores.ToString
gridError(vector)
Else
vector = fila("docentry").ToString + ";" + fila("tipo") + ";" + jsonErrores(0).mensaje_error.ToString + ";" + jsonElemento.cantidad_errores.ToString
gridError(vector)
End If
End If
And this is my delegate
Public Sub gridError(argumentos As String)
If Me.InvokeRequired() Then
Me.Invoke(New Action(Of String)(AddressOf gridError), argumentos)
Else
vector = argumentos.Split(delimitadores, StringSplitOptions.None)
If vector.Count = 3 Then
DataErrores.Rows.Add(vector(0), vector(1), vector(2))
ElseIf vector.Count = 2 Then
DataErrores.Rows.Add(vector(0), " ", vector(1))
End If
End If
End Sub
I cant understand why 1 character make this difference and i have the same issue with the if vector.count = 3
Related
I want to export animation as mp4 in PowerPoint and get the timeline of all animation.
How do I get the delay between letters if the effect has EffectInformation.TextUnitEffect as msoAnimTextUnitEffectByCharacter?
Most documentation for PowerPoint I have read, but no message for "%delay between letters".
effectinformation documentation has no message as delay between letters in (https://learn.microsoft.com/en-us/office/vba/api/powerpoint.effectinformation.textuniteffect)
CONST ppLayoutBlank = 12 ''ppt new black slide
CONST ppSaveAsMP4 = 39 ''ppSaveFormat for mp4
CONST ForAppending = 8 ''log file write for appending
const ppViewSlideMaster = 2 ''viewtype
const ppViewHandoutMaster = 4
const ppViewTitleMaster = 8
const ppViewMasterThumbnails = 12
const msoAnimTextUnitEffectByCharacter = 1
Dim filePath
dim logFilePath
dim logFile
dim fullPath
logFilePath = ".\convert.log" '''''''logfile
filePath = SelectFile()
if len(filePath)<1 then
wscript.quit
end if
MsgBox filePath + ";"
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
''create log file
if ObjFSO.fileExists(logFilePath) then
set logFile = ObjFSO.OpenTextFile(logFilePath, ForAppending)
else
set logFile = ObjFSO.CreateTextFile(logFilePath)
end if
''do job
pptAnimate(filePath)
''quit or not
''objPPT.Quit()
Function SelectFile()
dim selectPath,selectPathLen
Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
selectPath = oExec.StdOut.ReadAll
selectPathLen = len(selectPath)
SelectFile = left(selectPath, selectPathLen-2)'''''remove \r\n, vbcr、vblf
End Function
Sub pptAnimate(pptPath)
if not (regMatch(pptPath, "\.(ppt|pptx)$")) then
exit sub
end if
Set pptInput = objPPT.Presentations.Open(pptPath)
logFile.WriteLine("slide count:" + cstr(pptInput.Slides.Count))
For i = 1 To pptInput.Slides.Count
if pptInput.Slides(i).TimeLine.MainSequence.Count > 0 then
Dim tmpPath
tmpPath = "F:\\word\\" + cstr(i) + ".pptx"
ObjFSO.CreateTextFile(tmpPath)
Set pptOutput = objPPT.Presentations.Open(tmpPath)
Set newSlide = pptOutput.Slides.Add(1, ppLayoutBlank)
pptOutput.PageSetup.slideWidth = pptInput.PageSetup.slideWidth
pptOutput.pageSetup.slideHeight = pptInput.pagesetup.slideheight
pptInput.Slides(i).Copy
pptOutput.Slides.Paste (pptOutput.Slides.Count)
logFile.WriteLine("page:" + cstr(i) + " sequence count:" + cstr(pptInput.Slides(i).TimeLine.MainSequence.Count))
For Each effect in pptInput.Slides(i).TimeLine.MainSequence
logFile.WriteLine("{delay time:" + cstr(effect.Timing.TriggerDelayTime) _
+ ", duration time:" + cstr(effect.Timing.Duration) _
+ ", Decelerate :" + cstr(effect.Timing.Decelerate) _
+ ", triggerType:" + getTriggerType(effect.Timing.TriggerType) _
+ ", Accelerate:" + cstr(effect.Timing.Accelerate) _
+ ", Decelerate:" + cstr(effect.Timing.Decelerate) _
+ ", Speed:" + cstr(effect.Timing.Speed) _
+ "}")
if msoAnimTextUnitEffectByCharacter = effect.EffectInformation.TextUnitEffect then
''I don't know how to get dealy between letters, have no way to set the effect to by graph
''effect.EffectInformation.TextUnitEffect = 0 '''readonly
end if
For Each behaviour in effect.Behaviors
logFile.WriteLine("behaviour {delay time :" + cstr(behaviour.Timing.TriggerDelayTime) + ", duration time :" + cstr(behaviour.Timing.Duration) + "}")
Next
Next
m = pptOutput.Slides.Count
pptOutput.Slides(m).Delete
''fullPath = "F:\\word\\"+cstr(i)+".mp4"
''pptOutput.SaveAs fullPath,ppSaveAsMP4
'''wait until the mp4 file exist,
'''msgbox fullPath
pptOutput.Save
pptOutput.Close
end if
Next
pptInput.Close
End Sub
Function regMatch(strng,Pattern)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = Pattern
regEx.IgnoreCase = True
regEx.Global = True
regMatch = regEx.test(strng)
Set regEx = Nothing
End Function
'https://learn.microsoft.com/zh-cn/office/vba/api/powerpoint.msoanimtriggertype
Function getTriggerType(triggerType)
getTriggerType = ""
Select Case triggerType
Case 3
getTriggerType = "msoAnimTriggerAfterPrevious"
Case -1
getTriggerType = "msoAnimTriggerMixed"
Case 0
getTriggerType = "msoAnimTriggerNone"
Case 1
getTriggerType = "msoAnimTriggerOnPageClick"
Case 4
getTriggerType = "msoAnimTriggerOnShapeClick"
Case 2
getTriggerType = "msoAnimTriggerWithPrevious"
End Select
End Function
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " "& h &":" & mi &":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyymmdd
Format_Time = y & m & d
End Select
End Function
The value for "seconds delay between letters" is not directly exposed in the object model.
While it's still possible to extract the value in VBA, the process is quite complicated. At a high level, you need to:
Use Presentation.SaveCopyAs to save a copy in "pptx" format, but with the "zip" extension, e.g. temp.zip
Use late binding to create a Shell.Application object
Use the shell object to copy temp.zip\ppt\slides\slideN.xml to a folder (N = the slide number)
Read the XML file and inspect the animation element. The exact value you are looking for ("seconds delay between letters") should be in an element like <p:tmAbs val="50"/>
The timing is in ms. So the 50 in the example would be 0.05s in the PowerPoint UI.
Because there could be many animations on the same slide, you may need to find the right animation sequence in the XML. It's definitely not an easy process, and particularly challenging to do in VBA. If possible, I would recommend that you use build a small utility exe file using C# or VB.NET to parse the XML and read the necessary information directly from the PPTX file and invoke the program from VBA. We did something similar for a different purpose, and it worked fairly well.
The first three steps can be used for extracting almost everything not available through the Object Model. For Word, you don't have to do that because it exposes a property WordOpenXML. Unfortunately, such property does not exist in Excel or PowerPoint.
I need to pass the value to a textbox to form1, so i need to check first whether the form1 is empty or not.
If empty the value go to form1, if not the value will go to form2
I already tried several codes. It doesn't work.
The value didn't go to form2 when the textbox in form1 isn't empty
mainform
Dim OpenForm1 As New Form2
Dim OpenForm2 As New Form4
If String.IsNullOrEmpty(OpenForm1.tbOrderReceived1.Text) Then
OpenForm1.PassOrderKitchen1 = rbTable1.Text + ":" + cbSpagethi.Text + "-" + tbSpagehti.Text
ElseIf (OpenForm1.tbOrderReceived1.Text > 0) Then
OpenForm2.PassOrderKitchen2 = rbTable1.Text + ":" + cbSpagethi.Text + "-" + tbSpagehti.Text
End If
I think you just need a small change to what you have already coded. Remove the ElseIf and use Else instead:
Dim OpenForm1 As New Form2
Dim OpenForm2 As New Form4
If String.IsNullOrEmpty(OpenForm1.tbOrderReceived1.Text) Then
OpenForm1.PassOrderKitchen1 = rbTable1.Text + ":" + cbSpagethi.Text + "-" + tbSpagehti.Text
Else
OpenForm2.PassOrderKitchen2 = rbTable1.Text + ":" + cbSpagethi.Text + "-" + tbSpagehti.Text
End If
I have a problem in this code because I am not returning any thing!
It works Just as I want it without returning but when I return it crashes.
Can you please help?
Public Function Clear() As Boolean
'resetting the variuabels to be ready for next Order
ZYZZ = "0"
VAT = "0"
MAX = "0"
'this code is 3 peices
'This is sitting ctrl as a new control
Dim ctrl As Control = Me.GetNextControl(Me, True)
'1- is to look for text box and change them to 0 after the button is pressed
Do
If TypeOf ctrl Is TextBox Then
ctrl.Text = "0"
End If
ctrl = Me.GetNextControl(ctrl, True)
Loop Until ctrl Is Nothing
'2- it clears the list box
OrderListBox.Items.Clear()
'And uncheck the check boxes
LoyalCheckBox.Checked = False
TakeAwayCheckBox.Checked = False
'Finally it resets the Price, VAT, Total in the UI
Label6.Text = "£" & " " & "0"
Label7.Text = "£" & " " & "0"
Label8.Text = "£" & " " & "0"
'Clearing the array to prepare for next order
arr.Clear()
End Function
Also same problem in this code!
Private Function calculate() As Boolean
'=================================='
ZYZZ = 0
For i As Integer = 0 To arr.Count - 1
ZYZZ = ZYZZ + arr(i)
Next i
'=================================='
'=================================='
If LoyalCheckBox.Checked = True Then
CardT = ZYZZ * card
Else
CardT = "0"
End If
If TakeAwayCheckBox.Checked = True Then
TAF = ZYZZ * TA
Else
TAF = "0"
End If
'=================================='
VAT = ZYZZ * cVAT
MAX = ZYZZ - (CardT + TAF) + VAT
Label6.Text = "£" & " " & ZYZZ
Label7.Text = "£" & " " & VAT
Label8.Text = "£" & " " & MAX
End Function
I have looked up online but I did not understand the methods they are using that's why its better to ask a direct question, thank you.
Public Function Clear() As Boolean
You define the function as a function who will return a boolean value at all times.
But in your code you don't assign a return value at all.
If you don't want to return a value, just change your function name to:
Public Sub Clear()
If you want to return a value, you have to do so:
Public Function Clear() As Boolean
return False
End function
Return values
When you create a new function/method, you can choose if you want that function/method to return a value. This is optional but very useful.
Say that you want to write a function that calculates the sum of 2 values. What you would do, is write the function that way that you pass it the 2 values, and that it returns the sum:
Public Function SumOfValues(ByVal value1, ByVal value2) As Integer
The return-value will be an integer as defined with As Integer.
Then you do some code-magic, and at the end of your function, you return whatever you want to return, in my example: the sum of the 2 values:
Public Function SumOfValues(ByVal value1, ByVal value2) As Integer
Dim Sum As Integer = Value1 + Value2
Return Sum
End Function
So, now, whenever you want to know the sum of 2 values, you can just do this:
Dim answerOfLife As Integer = SumOfValues(21,21)
answerOfLife will be 42 in this example.
I'm trying to set the focus in a form after update. When I do this within the forms class module I have no problem. However, I need to do this in a few forms so I'm trying to write it in the module. My problem is I can't get the .SetFocus to work unless I hardcode the form name within the class module. WHno is the name of the control I'm trying to set focus.
I have attempted a number of options and none seem to work.
Here is the sub. Everything works wonderfully except the .SetFocus procedure.
Sub ValidateWHNO()
Dim EnteredWHNO As Integer
Dim actForm As String
Dim deWHNO As Variant
msg As Integer
Dim ctrlWHNO As Control
EnteredWHNO = Screen.ActiveControl.Value
actForm = Screen.ActiveForm.Name
Set ctrlWHNO = [Forms]![frmEnterBookData]![WHno]
deWHNO = DLookup("[WHno]", "tblDataEntry", "[WHno] = " & EnteredWHNO)
If EnteredWHNO = deWHNO Then
msg = MsgBox("You have already entered " & EnteredWHNO & " as a WHNO. The next number is " & DMax("[WHno]", "tblDataEntry") + 1 & ", use this?", 4 + 64, "Already Used WHno!")
If msg = 6 Then
Screen.ActiveControl.Value = DMax("[WHno]", "tblDataEntry") + 1
Else
Screen.ActiveControl.Value = Null
ctrlWHNO.SetFocus 'CODE THAT WONT RUN
End If
End If
End Sub
I've tried a number of other methods to set focus, such as:
Forms(actForm).WHno.SetFocus,
Forms(actForm).Controls(WHno).SetFocus, Screen.ActiveControl.SetFocus
The current result is that if No is selected in the MsgBox, the value is cleared, but the focus moves to the next control.
Thanks in advanced for any help that may be offered.
Does the following make a difference?
Sub ValidateWHNO(frm as Access.Form)
Dim EnteredWHNO As Integer
Dim actForm As String
Dim deWHNO As Variant
msg As Integer
EnteredWHNO = frm.ActiveControl.Value
actForm = frm.Name
deWHNO = DLookup("[WHno]", "tblDataEntry", "[WHno] = " & EnteredWHNO)
If EnteredWHNO = deWHNO Then
msg = MsgBox("You have already entered " & EnteredWHNO & " as a WHNO. The next number is " & DMax("[WHno]", "tblDataEntry") + 1 & ", use this?", 4 + 64, "Already Used WHno!")
If msg = 6 Then
frm.ActiveControl.Value = DMax("[WHno]", "tblDataEntry") + 1
Else
frm.ActiveControl.Value = Null
frm![WHno].SetFocus
End If
End If
End Sub
And your call from each form would be:
VaidateWHNO Me
Instead of using a relative reference to the form (Screen.ActiveForm), the code passes the form reference through directly and uses that reference as the parent of the .setFocus method.
I'm trying to make some labels on my Form to be visible, but i don't want to use a lot of if statements, but for some reason whenever i put Me.Controls(lbl).Visbel = True in a for or do loop it skips the whole loop. The code worked perfectly the way I wanted it until i got an error for calling Dim lbl = Controls("Label" & counter_3) for the whole class instead of in the From_load private sub. Sometimes i can get it to work, but only one label is visible
Dim chararray() As Char = word_list(random_word).ToCharArray
Dim lbl = "Label" & counter_3
For Each item In chararray
If item = Nothing Then
Else
word_list(counter_2) = item.ToString()
counter_2 += 1
End If
Next
For Each item In chararray
If item = Nothing Then
Else
counter_3 += 1
Me.Controls(lbl).Visible = True
MsgBox(item & " " & counter_3)
End If
Next
I've also tried. In both the loops are completely skipped over. I know this because the MsgBox's don't appear.
Dim chararray() As Char = word_list(random_word).ToCharArray
Dim lbl = Controls("Label" & counter_3)
For Each item In chararray
If item = Nothing Then
Else
word_list(counter_2) = item.ToString()
counter_2 += 1
End If
Next
For Each item In chararray
If item = Nothing Then
Else
counter_3 += 1
lbl.Visble = True
MsgBox(item & " " & counter_3)
End If
Next
The thing that I am noticing is that you are creating a Char array based on a random word returned from your word_list, you then iterate through the Char array using the count of the character in the array as an index into your word_list, if the amount of characters in your word exceeds the amount of words in your list you will get an error and since this error is in the Forms Load event it will be swallowed and all the code after it will be aborted. There are also other issues that I would change like making sure all declarations have a type and I would probably use the Controls.Find Method instead and check that it has an actual object. But what I would probably do first is move your code to a separate Subroutine and call it after your IntializeComponent call in the Forms Constructor(New) Method.
Something like this.
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
YourMethod
End Sub
Public Sub YourMethod()
Dim chararray() As Char = word_list(random_word).ToCharArray
Dim lbl As Control() = Controls.Find("Label" & counter_3, True)
For Each item In chararray
If item = Nothing Then
Else
word_list(counter_2) = item.ToString()
counter_2 += 1
End If
Next
For Each item In chararray
If item = Nothing Then
Else
counter_3 += 1
If lbl.Length > 0 Then
lbl(0).Visible = True
Else
MsgBox("Control not Found")
End If
MsgBox(item & " " & counter_3)
End If
Next
End Sub