VBA If Statement within For Each for Emulation

问题

I need to update several thousand X coordinates in BlueZone. I'm using VBA to enter key commands in BlueZone VT. Unfortunately, there is no "set cursor position" command, so I am limited to using "tabs" to put the cursor where it needs to go.

At the coordinate updating screen there are two possibilities: 6 or 7 tabs depending on the presence of a 0 or not on the screen.

For example: location 241054 has a 1 and needs 7 tabs, location 241051 has a 0 and needs 6 tabs to get to the X location field for me to dump in my variable.

Here is my code:

Sub FiXCoord_Loop()

'Must start at IMLOA screen

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myX As Integer
Dim res_check As Integer
Dim myLoc As Variant
'Dim res_check As Variant


myRange = ActiveSheet.Range("A2:A1000")
'myResRange = ActiveSheet.Range("D3")
myX = ActiveSheet.Range("E1").Value
res_check = ActiveSheet.Range("D3").Value

For Each myLoc In myRange


'end loop at blank cell
    If myLoc = "" Then
        Exit For
            End If

'Query location

bzhao.SendKey "Q"
bzhao.Wait 0.2
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<enter>"
bzhao.Wait 0.2

'Copy screen to get res#

bzhao.Wait 1
bzhao.Copy 32
bzhao.Wait 1

'Paste info to sheet for res_check

Range("J1").Select
ActiveSheet.Paste


bzhao.SendKey "M"
bzhao.Wait 0.2
bzhao.SendKey "<tab>"
bzhao.Wait 0.2
bzhao.SendKey "<tab>"
bzhao.Wait 0.2
bzhao.SendKey "<tab>"
bzhao.Wait 0.2
bzhao.SendKey "<tab>"
bzhao.Wait 0.2
bzhao.SendKey "<tab>"



'if value > 0 extra tab

If res_check > 0 Then

    bzhao.SendKey "<tab>"
    bzhao.Wait 1
    bzhao.SendKey "<tab>"
    bzhao.Wait 1
    bzhao.SendKey myX
    bzhao.Wait 0.2
    bzhao.SendKey "<enter>"
    bzhao.Wait 0.2
    bzhao.SendKey "E"
    bzhao.Wait 0.5

Else

bzhao.Wait 0.2
bzhao.SendKey "<tab>"
bzhao.Wait 1
bzhao.SendKey myX
bzhao.Wait 0.2
bzhao.SendKey "<enter>"
bzhao.Wait 0.2
bzhao.SendKey "E"
bzhao.Wait 0.5

End If


Next myLoc


End Sub

As I'm limited to walking the screen by key commands, I am copying the screen and pasting it onto my sheet to check for the 0 or not. I cannot get the if - then statement to work, though.

The code just keeps running with 6 tabs which tells me that either the res_check value (which is a mid() statement to pull the value off the screen) is not being recognized, or the the variable doesn't update with the loop. If I run the res_check > 0 location first, though, it still does 6 tabs so I can eliminate that possibility.

As a further check I ran a TRUE FALSE check on the res_check value and it passed when dimmed as an integer. On the sheet, though, ISNUMBER() fails.

TLDR: If Then will not produce desired result - code keeps defaulting to the Else condition.

回答1:

The below code works.

Cell D3 =mid(J7, 63, 1) and cell D8 =D3*1

I also did @donpablo's suggested indent (see comments).

Sub FiXCoord_Loop()

'Must start at IMLOA screen

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myX As Integer
Dim res_check As Integer
Dim myLoc As Variant



myRange = ActiveSheet.Range("A2:A1000")
myX = ActiveSheet.Range("E1").Value
res_check = ActiveSheet.Range("D8").Value

For Each myLoc In myRange


'end loop at blank cell
    If myLoc = "" Then
        Exit For
            End If

'Query location

bzhao.SendKey "Q"
bzhao.Wait 0.2
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<enter>"
bzhao.Wait 0.2

'Copy screen to get res#

bzhao.Wait 1
bzhao.Copy 32
bzhao.Wait 1

'Paste info to sheet for res_check

Range("J1").Select
ActiveSheet.Paste

'Modify data

bzhao.SendKey "M"
bzhao.Wait 0.2
bzhao.SendKey "<tab><tab><tab><tab><tab>" 'tab to Res


'Decide 6 or 7 tabs

If ActiveSheet.Range("D8").Value > 0 Then

    bzhao.Wait 0.1
    bzhao.SendKey "<tab>"

Else

    End If

bzhao.Wait 0.1
bzhao.SendKey "<tab>"
bzhao.Wait 0.1
bzhao.SendKey myX
bzhao.Wait 0.1
bzhao.SendKey "<enter>"
bzhao.Wait 0.1
bzhao.SendKey "E"
bzhao.Wait 0.5


Next myLoc


End Sub

来源：https://stackoverflow.com/questions/58958879/vba-if-statement-within-for-each-for-emulation

标签

excel

vba

if-statement

emulation

bluezone