I have written the following code to print specific pages of a worksheet depending on which active worksheets are selected. Some worksheets have list tables which need to be filtered. When I run the printingSheets() procedure on its own it prints fine. When I call it in the before print procedure it prints the first workbook in the selection twice. Can someone explain this to me?
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Call printingSheets
End Sub
Sub printingSheets()
Dim ws As Worksheet
Dim arySheets
Dim selSheets
Dim iSheet As Long
Dim i As Long
Set selSheets = ThisWorkbook.Windows(1).selectedSheets
i = 0
ReDim arySheets(selSheets.Count)
For Each ws In selSheets
arySheets(iSheet) = ws.Name
iSheet = iSheet + 1
With ws
If ws.Name = "12-32" Then
Worksheets("12-32").Activate
x = x + 1
ws.ListObjects("Table9").Range.AutoFilter Field:=1, Criteria1:= _
"<>"
ws.PageSetup.PrintArea = "$A$1:$J$249"
ws.PrintOut From:=1, to:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.PageSetup.PrintArea = "$A$1:$K$249"
ws.PrintOut From:=3, to:=3, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.ListObjects("Table9").Range.AutoFilter Field:=1
Application.EnableEvents = True
Cancel = True
ElseIf ws.Name = "13-33" Then
Worksheets("13-33").Activate
x = x + 1
ws.ListObjects("Table8").Range.AutoFilter Field:=1, Criteria1:= _
"<>"
ws.PageSetup.PrintArea = "$A$1:$J$249"
ws.PrintOut From:=1, to:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.PageSetup.PrintArea = "$A$1:$K$249"
ws.PrintOut From:=3, to:=3, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.ListObjects("Table8").Range.AutoFilter Field:=1
Application.EnableEvents = True
Cancel = True
ElseIf ws.Name = "Cap11-31" Then
Worksheets("Cap11-31").Activate
x = x + 1
ws.ListObjects("Table10").Range.AutoFilter Field:=1, Criteria1:= _
"<>"
ws.PageSetup.PrintArea = "$A$1:$J$249"
ws.PrintOut From:=1, to:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.PageSetup.PrintArea = "$A$1:$K$249"
ws.PrintOut From:=3, to:=3, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.ListObjects("Table10").Range.AutoFilter Field:=1
Application.EnableEvents = True
Cancel = True
ElseIf ws.Name = "Cap10-30" Then
Worksheets("Cap10-30").Activate
x = x + 1
ws.ListObjects("Table11").Range.AutoFilter Field:=1, Criteria1:= _
"<>"
ws.PageSetup.PrintArea = "$A$1:$J$249"
ws.PrintOut From:=1, to:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.PageSetup.PrintArea = "$A$1:$K$249"
ws.PrintOut From:=3, to:=3, Copies:=1, Collate:=True, IgnorePrintAreas:=False
ws.ListObjects("Table11").Range.AutoFilter Field:=1
Application.EnableEvents = True
Cancel = True
Else
ws.PrintOut From:=1, to:=1, Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.EnableEvents = True
Cancel = True
End If
End With
Next ws
End Sub
Related
function CountCops()
local xPlayers = ESX.GetPlayers()
CopsConnected = 0
for i=1, #xPlayers, 1 do
local xPlayer = ESX.GetPlayerFromId(xPlayers[i])
if xPlayer.job.name == 'police' then
CopsConnected = CopsConnected + 1
end
end
SetTimeout(120 * 1000, CountCops)
end
Does anyone know how would I have both if xPlayer.job.name == 'police' or xPlayer.job.name == 'sheriff' read for = 1 cop for each person.
So if one police was on then it = 1
and if one sheriff was on it would = 2.
local countingJobs = {
['police'] = true,
['sheriff'] = true
};
function CountCops()
local xPlayers = ESX.GetPlayers()
CopsConnected = 0
for i=1, #xPlayers, 1 do
local xPlayer = ESX.GetPlayerFromId(xPlayers[i])
if countingJobs[xPlayer.job.name] then
CopsConnected = CopsConnected + 1
end
end
SetTimeout(120 * 1000, CountCops)
end
Since I have a collision check function in Lua:
function onCollision(obj1,obj2)
obj1x = obj1.left
obj1y = obj1.top
obj1w = obj1.width
obj1h = obj1.height
obj2x = obj2.left
obj2y = obj2.top
obj2w = obj2.width
obj2h = obj2.height
if obj2x + obj2w >= obj1x and obj2y + obj2h >= obj1y and obj2y <= obj1y + obj1h and obj2x <= obj1x + obj1w then
return true
end
end
And I did make some panels as bricks using array table on my form, with this function, I did collision check between ball with each form sides without problems.
function createBricks()
for row = 1, brickRows do
bricks[row] = {}
for col = 1, brickColumns do
local x = (col - 1) * (width + gap) -- x offset
local y = (row - 1) * (height + gap) -- y offset
local newBrick = createPanel(gamePanel)
newBrick.width = brickWidth
newBrick.height = brickHeight
newBrick.top = y + 15
newBrick.left = x + 15
newBrick.BorderStyle = 'bsNone'
if level == 1 then newBrick.color = '65407' -- green
elseif level == 2 then newBrick.color = '858083' -- red
elseif level == 3 then newBrick.color = '9125192' -- brown
elseif level == 4 then newBrick.color = math.random(8,65255) end
bricks[row][col] = newBrick
end
end
end
Next how to detect if the ball collided with the bricks?. So far I did:
for row = 1, brickRows do
bricks[row] = {}
for col = 1, brickColumns do
dBrick = bricks[row][col]
if onCollision(gameBall,dBrick) then
dBrick.destroy() -- destroy the collided brick
end
end
end
I want to learn how to implement this collision logic in VB Net script which VB script easier for me, I did the whole game project using VB Net, now I try to re-write the project using CE Lua.
Private brickArray(brickRows, brickColumns) As Rectangle
Private isBrickEnabled(brickRows, brickColumns) As Boolean
For rows As Integer = 0 To brickRows
For columns As Integer = 0 To brickColumns
If Not isBrickEnabled(rows, columns) Then Continue For
If gameBall.IntersectsWith(brickArray(rows, columns)) Then
isBrickEnabled(rows, columns) = False
If gameBall.X + 10 < brickArray(rows, columns).X Or _
gameBall.X > brickArray(rows, columns).X + brickArray(rows, columns).Width _
Then
xVel = -xVel
Else
yVel = -yVel
End If
End If
Next
Next
And also this private sub, how to write it CE Lua?
Sub loadBricks()
Dim xOffset As Integer = 75, yOffset As Integer = 100
For row As Integer = 0 To brickRows
For column As Integer = 0 To brickColumns
brickArray(row, column) = New Rectangle(xOffset, yOffset, brickWidth, brickHeight)
xOffset += brickWidth + 10
isBrickEnabled(row, column) = True
Next
yOffset += brickHeight + 10
xOffset = 75
Next
End Sub
Function getBrickCount() As Integer
Dim Count As Integer = 0
For Each brick As Boolean In isBrickEnabled
If brick = True Then Count += 1
Next
Return Count
End Function
function onCollision(obj1,obj2)
obj1x = obj1.left
obj1y = obj1.top
obj1w = obj1.width
obj1h = obj1.height
obj2x = obj2.left
obj2y = obj2.top
obj2w = obj2.width
obj2h = obj2.height
if obj2x + obj2w >= obj1x and obj2y + obj2h >= obj1y and obj2y <= obj1y + obj1h and obj2x <= obj1x + obj1w then
return true
end
end
Then to detect collision the collision and remove from the table:
-- Drawback table
local function tcount( t )
local c = 0
for k,v in pairs(t) do
c = c + 1
end
return c
end
local count = #brickArray
for x = 1, count do
if onCollision(gameBall, brickArray[x]) then
if gameBall.Left + 10 < brickArray[x].Left or gameBall.Left > brickArray[x].Left + brickArray[x].Width then
xVel = -xVel else yVel = -yVel
end
playSound(findTableFile('strikeball.wav'))
brickArray[x] = brickArray[count]
brickArray[x] = x
brickArray[count] = nil
brickArray[x].Visible = false
tcount(brickArray)
end
end
The code above detected the collision and remove the object from the table, but that is not removed from display. How to remove the bricks from the table and display, using Cheat Engine Lua script?.
I really need help..
I have this code for fly, as a backpack item:
Name = "Fly"
pi = 3.141592653589793238462643383279502884197163993751
a = 0
s = 0
ndist = 13
rs = 0.025
siz = Vector3.new(1, 1, 1)
form = 0
flow = {}
function CFC(P1,P2)
local Place0 = CFrame.new(P1.CFrame.x,P1.CFrame.y,P1.CFrame.z)
local Place1 = P2.Position
P1.Size = Vector3.new(P1.Size.x,P1.Size.y,(Place0.p - Place1).magnitude)
P1.CFrame = CFrame.new((Place0.p + Place1)/2,Place0.p)
end
function checktable(table, parentneeded)
local i
local t = {}
for i = 1, #table do
if table[i] ~= nil then
if string.lower(type(table[i])) == "userdata" then
if parentneeded == true then
if table[i].Parent ~= nil then
t[#t + 1] = table[i]
end
else
t[#t + 1] = table[i]
end
end
end
end
return t
end
if script.Parent.Name ~= Name then
User = game:service("Players").Nineza
HB = Instance.new("HopperBin")
HB.Name = Name
HB.Parent = User.StarterGear
script.Parent = HB
User.Character:BreakJoints()
end
speed = 50
script.Parent.Selected:connect(function(mar)
s = 1
torso = script.Parent.Parent.Parent.Character.Torso
LeftShoulder = torso["Left Shoulder"]
RightShoulder = torso["Right Shoulder"]
LeftHip = torso["Left Hip"]
RightHip = torso["Right Hip"]
human = script.Parent.Parent.Parent.Character.Humanoid
bv = Instance.new("BodyVelocity")
bv.maxForce = Vector3.new(0,math.huge,0)
bv.velocity = Vector3.new(0,0,0)
bv.Parent = torso
bg = Instance.new("BodyGyro")
bg.maxTorque = Vector3.new(0,0,0)
bg.Parent = torso
connection = mar.Button1Down:connect(function()
a = 1
bv.maxForce = Vector3.new(math.huge,math.huge,math.huge)
bg.maxTorque = Vector3.new(900000,900000,900000)
bg.cframe = CFrame.new(torso.Position,mar.hit.p) * CFrame.fromEulerAnglesXYZ(math.rad(-90),0,0)
bv.velocity = CFrame.new(torso.Position,mar.hit.p).lookVector * speed
moveconnect = mar.Move:connect(function()
bg.maxTorque = Vector3.new(900000,900000,900000)
bg.cframe = CFrame.new(torso.Position,mar.hit.p) * CFrame.fromEulerAnglesXYZ(math.rad(-90),0,0)
bv.velocity = CFrame.new(torso.Position,mar.hit.p).lookVector * speed
end)
upconnect = mar.Button1Up:connect(function()
a = 0
moveconnect:disconnect()
upconnect:disconnect()
bv.velocity = Vector3.new(0,0,0)
bv.maxForce = Vector3.new(0,math.huge,0)
torso.Velocity = Vector3.new(0,0,0)
bg.cframe = CFrame.new(torso.Position,torso.Position + Vector3.new(torso.CFrame.lookVector.x,0,torso.CFrame.lookVector.z))
wait(1)
end)
end)
while s == 1 do
wait(0.02)
flow = checktable(flow, true)
local i
for i = 1,#flow do
flow[i].Transparency = flow[i].Transparency + rs
if flow[i].Transparency >= 1 then flow[i]:remove() end
end
if a == 1 then
flow[#flow + 1] = Instance.new("Part")
local p = flow[#flow]
p.formFactor = form
p.Size = siz
p.Anchored = true
p.CanCollide = false
p.TopSurface = 0
p.BottomSurface = 0
if #flow - 1 > 0 then
local pr = flow[#flow - 1]
p.Position = torso.Position - torso.Velocity/ndist
CFC(p, pr)
else
p.CFrame = CFrame.new(torso.Position - torso.Velocity/ndist, torso.CFrame.lookVector)
end
p.BrickColor = BrickColor.new("Cyan")
p.Transparency = 1
p.Parent = torso
local marm = Instance.new("BlockMesh")
marm.Scale = Vector3.new(1.9, 0.9, 1.725)
marm.Parent = p
local amplitude
local frequency
amplitude = pi
desiredAngle = amplitude
RightShoulder.MaxVelocity = 0.4
LeftShoulder.MaxVelocity = 0.4
RightHip.MaxVelocity = pi/10
LeftHip.MaxVelocity = pi/10
RightShoulder.DesiredAngle = desiredAngle
LeftShoulder.DesiredAngle = -desiredAngle
RightHip.DesiredAngle = 0
LeftHip.DesiredAngle = 0
end
end
end)
script.Parent.Deselected:connect(function()
a = 0
s = 0
bv:remove()
bg:remove()
if connection ~= nil then
connection:disconnect()
end
if moveconnect ~= nil then
moveconnect:disconnect()
end
if upconnect ~= nil then
upconnect:disconnect()
end
while s == 0 do
wait()
if #flow > 0 then
flow = checktable(flow, true)
local i
for i = 1,#flow do
flow[i].Transparency = flow[i].Transparency + rs
if flow[i].Transparency >= 1 then flow[i]:remove() end
end
end
end
end)
while true do
wait()
if s == 1 then
return
end
end
script:remove()
The script is in a HopperBin Object in the game's StarterPack Folder.
Now if you try it on your own, you'll see that it will work, BUT if you publish the game, play it via ROBLOX(not the studio) and try to use the item, you won't fly.
Any ideas why?
It's been a long time since I haven't played ROBLOX, so my answer might be inaccurate.
First, you need to understand the difference between a Script and a Localscript. In a nutshell, a script runs server-side whereas a Localscript runs client-side. Your fly script is expected to run on a player's client, thus you have to use a Localscript.
Your regular script works in build-mode because scripts are run on your client, and thus are considered as Localscripts. When you publish your game and play it, your computer doesn't work as a server anymore, but as a client.
In addition to this, as you use a localscript, you may have to change the following line :
-- gets the client (local player) on which the script is running
User = Game:GetService("Players").LocalPlayer
Also, avoid relative paths such as script.Parent.Parent.Parent..... You want to get the client's torso, so just use your User variable as per : User.Character.Torso. Do the same for the character's Humanoid object.
I think it's because the time to load not existing try this at line1:
repeat wait() until game.Players.LocalPlayer.Character
I have a project where the user pulls up a specific URL where the values for Dept, Queue, and Day change by what hyperlink they choose. For example, they would click on a hyperlink and the URL would be something like:
http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptOne&Queue=18&Day=0
The next hyperlink could be:
http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9.
I would like to use InStr to find Dept, Queue, and Day within the URL, then set their values to variables, such as UDept, UQueue, and UDay. Depending upon these values, the user can then copy a specific ID number that can only be found on the URL with these values. The end result would be a search for the URL:
http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=UDept&Queue=UQueue&Day=UDay
Here's my code so far:
Option Explicit
Dim objIE, objShell, objShellWindows
Dim strIDNum, strURL, strWindow, strURLFound, WShell, i
strURL = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptOne&Queue=18&Day=0"
strWindow = "Workflow Process"
Set objIE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
Set WShell = CreateObject("WScript.Shell")
strURLFound = False
'To fix item not found error
For Each objIE in objShellWindows
Next
For i = 0 to objShellWindows.Count - 1
Set objIE = objShellWindows.Item(i)
On Error Resume Next
If InStr(Ucase(objShellWindows.Item(i).LocationURL), Ucase(strURL)) Then
If InStr(Ucase(objShellWindows.Item(i).FullName), "IEXPLORE.EXE") Then
If Err.Number = 0 Then
If InStr(objShellWindows.Item(i).document.title, (strWindow)) Then
strURLFound = True
Exit For
End If
End If
End If
End If
Next
WShell.AppActivate strWindow
WScript.Sleep 300
strIDNum = objIE.document.getElementByID("ID_PlaceHolder").value
Thank you in advance to anyone who can help me with this.
Have you considered using a regular expression?
dim re, s
dim matches
s = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"
Set re = new RegExp
re.Pattern = ".*?Dept=(\w+)&Queue=(\d+)&Day=(\d+)$"
Set matches = re.Execute(s)
Dim uDept, uQueue, uDay
uDept = matches(0).submatches(0)
uQueue = matches(0).submatches(1)
uDay = matches(0).submatches(2)
Msgbox join(array("uDept = " & uDept, "uQueue = " & uQueue , "uDay = " & uDay), vbNewLine)
' Output:
' uDept = DeptFive
' uQueue = 13
' uDay = 9
To replace you can also use a Regular Expression:
Set re = new RegExp
s = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"
newDept = "DeptFourtyTwo"
newQueue = 404
newDay = 12
re.Pattern = "(Dept=)\w+"
newUrl = re.Replace(s, "$1" & newDept)
re.Pattern = "(Queue=)\d+"
newUrl = re.Replace(newUrl, "$1" & newQueue)
re.Pattern = "(Day=)\d+"
newUrl = re.Replace(newUrl, "$1" & newDay)
msgbox newUrl
' output:
' http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFourtyTwo&Queue=404&Day=12
' Alternatively you can replace everything at once if the order and presence of
' parameters is guaranteed:
re.Pattern = "(Dept=)\w+(&Queue=)\d+(&Day=)\d+"
MsgBox re.Replace(s, "$1DeptFourtyTwo$2404$312")
This only using Instr and Mid Function's
s="http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"
a = InStr(s, "?") 'We get the value until ?
d1 = Mid(s, a)
c1 = InStr(d1, "=")
c2 = InStr(d1, "&")
d2 = Mid(d1, c2 + 1)
d3 = Mid(d1, c1 + 1, (c2 - c1) - 1) 'value of Dept is d3
c3 = InStr(d2, "=")
c4 = InStr(d2, "&")
d5 = Mid(d2, c4 + 1)
d4 = Mid(d2, c3 + 1, (c4 - c3) - 1) 'value of Queue is d4
c6 = InStr(d5, "=")
d6 = Mid(d5, c6 + 1) ' Value of Day is d6
Hope this helps
Can we plot multiple box polt for single point similar to what we do in bar chart that we have multiple bar at single point.
Thanks
Akshay
You can have multiple BoxSeries, something like the example here:
http://www.teechart.net/support/viewtopic.php?f=3&t=13048&hilit=boxplot
It's a Delphi example, but it shouldn't be very different in ActiveX.
UPDATE:
From your comments, I understand you want to have some boxes in different X positions, and probably in groups. here it is a simple example of how you could play with the Positions to achieve the same:
Dim nSeries, groupSize As Integer
Private Sub Form_Load()
Dim i, aIndex, sIndex, lIndex, tmpX As Integer
TeeCommander1.ChartLink = TChart1.ChartLink
'TChart1.Header.Text.Text = TChart1.Version
TChart1.Aspect.View3D = False
TChart1.Panel.MarginTop = 7
TChart1.Header.Visible = False
TChart1.Axis.Bottom.Ticks.Visible = False
TChart1.Axis.Bottom.MinorTicks.Visible = False
nSeries = 8
groupSize = 2
aIndex = TChart1.Tools.Add(tcAnnotate)
TChart1.Tools.Items(aIndex).asAnnotation.Text = "group 1"
tmpX = 0
For i = 0 To nSeries - 1
sIndex = TChart1.AddSeries(scBox)
TChart1.series(sIndex).FillSampleValues
TChart1.series(sIndex).asBoxPlot.Position = tmpX
If (i + 1) Mod groupSize Then
tmpX = tmpX + 1
Else
If i + 1 < nSeries - 1 Then
lIndex = TChart1.Tools.Add(tcColorLine)
TChart1.Tools.Items(lIndex).asColorLine.Axis = TChart1.Axis.Bottom
TChart1.Tools.Items(lIndex).asColorLine.Value = tmpX + 1
tmpX = tmpX + 2
aIndex = TChart1.Tools.Add(tcAnnotate)
TChart1.Tools.Items(aIndex).asAnnotation.Text = "group " + Str$(((i + 1) / groupSize) + 1)
End If
End If
Next i
TChart1.Environment.InternalRepaint
End Sub
Private Sub TChart1_OnAfterDraw()
Dim tmpX As Integer
For i = 0 To TChart1.Tools.Count - 1
If TChart1.Tools.Items(i).ToolType = tcAnnotate Then
With TChart1.Tools.Items(i).asAnnotation
If i = TChart1.Tools.Count - 1 Then
tmpX = TChart1.GetChartRect.Right
Else
tmpX = TChart1.Axis.Bottom.CalcXPosValue(TChart1.Tools.Items(i + 1).asColorLine.Value)
End If
If i = 0 Then
tmpX = TChart1.GetChartRect.Left + (tmpX - TChart1.GetChartRect.Left) / 2
Else
tmpX = TChart1.Axis.Bottom.CalcXPosValue(TChart1.Tools.Items(i - 1).asColorLine.Value) + (tmpX - TChart1.Axis.Bottom.CalcXPosValue(TChart1.Tools.Items(i - 1).asColorLine.Value)) / 2
End If
.Left = tmpX - .Width / 2
End With
End If
Next i
End Sub
Private Sub TChart1_OnGetAxisLabel(ByVal Axis As Long, ByVal SeriesIndex As Long, ByVal ValueIndex As Long, LabelText As String)
If Axis = 3 Then
LabelText = " "
End If
End Sub