I receive the error: Method or data member not found at line
.SendKeys ("")
I am scraping from a screen and this the command I send to place the cursor in the right place before sending the command in the next line to change screens. I do not understand why I am receiving this error.
Sub RLinfo()
Dim sys
Dim sess
Dim chan
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim linecount As Long
' RL Information xxxx
Set Host = CreateObject("BZWh.WhllObj")
Host.OpenSession 0, 1, "xxxx.zmd", 30, 1
Set sess = Host.ActiveSession
Set chan = sess.Screen
Set ws = Worksheets("Information")
With ws
x = 14
y = 19
Set OUTPUTSHEET = ActiveWorkbook.Sheets("Information")
With chan
linecount = 2
Do While OUTPUTSHEET.Cells(linecount, 30) = "Zip"
RL = Format(OUTPUTSHEET.Cells(linecount, 1), "000000000")
.SendKeys ("<Home>")
.SendKeys ("/for x203<Enter>")
.waithostquiet (10)
.SendKeys (RL & "<Enter>")
.waithostquiet (10)
If Trim(.getstring(14, 2, 30)) = "RL WAS NOT FOUND" Then
OUTPUTSHEET.Cells(linecount, 20) = "RL No Longer In X203"
GoTo Found
Else
End If
OUTPUTSHEET.Cells(linecount, 17) = Trim(.getstring(11, 6, 6))
OUTPUTSHEET.Cells(linecount, 18) = Trim(.getstring(8, 27, 12))
OUTPUTSHEET.Cells(linecount, 19) = Trim(.getstring(9, 27, 12))
OUTPUTSHEET.Cells(linecount, 20) = Trim(.getstring(5, 41, 26))
For x = 14 To 20
If Trim(.getstring(x, 2, 7)) = "NUM" Then
OUTPUTSHEET.Cells(linecount, 21) = Trim(.getstring(x, 11, 11))
GoTo Found
Else
End If
Next x
If Trim(.getstring(23, 72, 6)) = "N MORE" Then
.SendKeys ("<PA1>")
.waithostquiet (10)
For y = 19 To 22
If Trim(.getstring(y, 2, 7)) = "NUM" Then
OUTPUTSHEET.Cells(linecount, 21) = Trim(.getstring(y, 11, 11))
GoTo Found
Else
End If
Next y
Else
End If
Found:
linecount = linecount + 1
Loop
End With
End With
ws.Cells(2, 31) = linecount
endM:
End Sub
The cause of my problem was that I was not disconnecting from the Host when I moved between modules. At the start of each module I was reconnecting to the Host even though I had not disconnected in the previous module and this caused the run time error.
Related
can any one find any error? For some reason when i add last2 it gives na object defined error.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim src As Workbook
' Abrir EXCEL
Set src = Workbooks.Open
("U:\Mecânica\Produção\Manutenção_teste\TOA\manTOA.xlsm", True, False)
WS_Count = src.Worksheets.Count
For o = 1 To WS_Count
src.Worksheets(o).Unprotect password:="projmanutencao"
Next o
last = src.Worksheets("Manutencao").Range("A65536").End(xlUp).Row
folha = manutencaoexp.Label27.Caption
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
' Escrever Registos
If manutencaoexp.ComboBox4 = "" Then
MsgBox "Introduzir todos os dados"
GoTo fim
Else
src.Worksheets("Manutencao").Cells(last + 1, 1) = Now() 'data
src.Worksheets("Manutencao").Cells(last + 1, 2) = manutencaoexp.Label28.Caption 'nº equipamento
src.Worksheets("Manutencao").Cells(last + 1, 3) = manutencaoexp.ComboBox5 'avaria
src.Worksheets("Manutencao").Cells(last + 1, 4) = manutencaoexp.ComboBox4 'serviços
src.Worksheets("Manutencao").Cells(last + 1, 5) = manutencaoexp.ComboBox7 'produtos
src.Worksheets("Manutencao").Cells(last + 1, 6) = Application.ThisWorkbook.Worksheets(folha).Cells(Monitorform.ComboBox1.ListIndex + 2, 32).Text 'duração
src.Worksheets("Manutencao").Cells(last + 1, 7) = manutencaoexp.TextBox2 'operario
src.Worksheets("Manutencao").Cells(last + 1, 8) = manutencaoexp.ComboBox6 'tipo de manutenção
src.Worksheets("Manutencao").Cells(last + 1, 9) = manutencaoexp.TextBox3 'quantidade
src.Worksheets("saidas").Cells(last2 + 1, 1) = manutencaoexp.ComboBox7 'código/produtos
'manutencaoexp.Hide
manutencaoexp.ComboBox7 = ""
manutencaoexp.TextBox3 = ""
MsgBox "Dados Introduzidos com sucesso"
End If
For o = 1 To WS_Count
src.Worksheets(o).Protect password:="projmanutencao"
Next o
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
' CLOSE THE SOURCE FILE.
src.Close True ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
fim:
End Sub
My problem is that i want to run
src.Worksheets("saidas").Cells(last2 + 1, 1) = manutencaoexp.ComboBox7
but i get na error on
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
Other than that everything is running fine.
If there's any other way around to solve this error , maybe adding another button or something else.
last2 = src.Worksheets("saidas").Range("A65536").End(x1Up).Row
If you look VERY carefully at this line, you'll notice that you actually have the number 1 instead of the letter L in End(x1Up)
How that happened, I have no idea. So change the line to:
last2 = src.Worksheets("saidas").Range("A65536").End(xlUp).Row
I have a VBA sub to create a few shapes, these shapes are then renamed to a cell value (B5:B15) and add text (C5:C15).
The shapes gets created, renamed and the text gets added but when I try to connect them I get the "Object Required".
Can some one please help me.
Thanks in advance.
Sub Button1_Click()
Dim s, conn As Shape, i As Integer
Set w = ActiveSheet
For i = 5 To 7
Set s = w.Shapes.AddShape(1, 800, i * 120 - 599, 100, 100)
s.Name = Range("B" & i)
s.TextFrame.Characters.Text = Range("C" & i)
s.Fill.ForeColor.RGB = RGB(0, 0, 213)
s.TextFrame.Characters.Font.ColorIndex = 19
Next i
Set conn = w.Shapes.AddConnector(1, 1, 1, 1, 1)
conn.ConnectorFormat.BeginConnect A001, 1
conn.ConnectorFormat.EndConnect A002, 1
End Sub
Something that would work:
Option Explicit
Sub Button1_Click()
Dim s As Shape, conn As Shape, i As Long
Dim w As Worksheet
Set w = ActiveSheet
Dim arr As Variant
ReDim arr(5 To 7)
For i = 5 To 7
Set s = w.Shapes.AddShape(1, 800, i * 120 - 599, 100, 100)
s.Name = Range("B" & i)
s.TextFrame.Characters.Text = Range("C" & i)
s.Fill.ForeColor.RGB = RGB(0, 0, 213)
s.TextFrame.Characters.Font.ColorIndex = 19
Set arr(i) = s
Next i
Set conn = w.Shapes.AddConnector(1, 1, 1, 1, 1)
conn.ConnectorFormat.BeginConnect arr(5), 1
conn.ConnectorFormat.EndConnect arr(6), 1
End Sub
What is the difference?
declaration of all variables - s is a Shape, i is a Long, w is a Worksheet;
the declaration is forced by Option Explicit;
a new variable arr is introduced, which keeps all the newly created forms. Thus the first form is kept under arr(5) and the last form is arr(7);
the BeginConnect and EndConnect need a variable which is a form. This is where we use the arr(5) to arr(7);
You can also refer to the shape, by its name and the Shapes() collection. Thus, the last 3 lines should look like this:
Set conn = w.Shapes.AddConnector(1, 1, 1, 1, 1)
conn.ConnectorFormat.BeginConnect w.Shapes("A001"), 1
conn.ConnectorFormat.EndConnect w.Shapes("A002"), 1
I have the below line that is receiving a "Object doesn't support the property or method error, but i am not seeing any issues.
Dim compliance As Worksheet
Dim report As Worksheet
Dim completeList As Worksheet
Sub getcompliance()
Dim i As Long
Dim n As Long
Dim Source As String
Set compliance = ActiveWorkbook.Worksheets("Compliance")
Set report = ActiveWorkbook.Worksheets("Report")
For i = 3 To report.UsedRange.Rows.Count
For n = 2 To compliance.UsedRange.Rows.Count
report(i, 19) = Application.WorksheetFunction.VLookup(report("i, 3"), compliance("A1:AC2400"), 29, False)
Next n
Next i
End Sub
Your line saying
report(i, 19) = Application.WorksheetFunction.VLookup(report("i, 3"), compliance("A1:AC2400"), 29, False)
should probably say
report.Cells(i, 19) = Application.WorksheetFunction.VLookup(report.Cells(i, 3), compliance.Range("A1:AC2400"), 29, False)
but, if so, why are you doing that in a For n loop?
Perhaps you mean your code to be:
Dim compliance As Worksheet
Dim report As Worksheet
Dim completeList As Worksheet
Sub getcompliance()
Dim i As Long
Set compliance = ActiveWorkbook.Worksheets("Compliance")
Set report = ActiveWorkbook.Worksheets("Report")
For i = 3 To report.UsedRange.Rows.Count
report.Cells(i, 19) = Application.WorksheetFunction.VLookup(report.Cells(i, 3), compliance.Range("A1:AC" & compliance.UsedRange.Rows.Count), 29, False)
'Or, simply using the full columns:
'report.Cells(i, 19) = Application.WorksheetFunction.VLookup(report.Cells(i, 3), compliance.Range("A:AC"), 29, False)
Next i
End Sub
' vvvvv vvvvvvvvvvvvv
report.Cells(i, 19) = WorksheetFunction.VLookup(report.Cells(i, 3), compliance.Range("A1:AC2400"), 29, False)
' ^^^^^^
I have made a userform that allows the user to select a table and add rows to it and fill those rows with various information, all from the userform. I have run into a few problems with this.
First after adding or during adding the items (after hitting submit) excel would crash. It occurs randomly and is hard to reproduce.
Second after running the macro there is a good chance that all the cells in the workbook and every other object except the userform button will stop working, meaning you can't edit interact or even select anything. Then when I close the workbook excel crashes after saving. This is my major offender and I think causes the other problem.
What causes this freezing and why does it occur? How do I fix it? I have looked around and haven't found anything circumstantial. One post said that I should try editing the table with no formatting on it and I did that and it didn't work.
I can provide the excel workbook at a request basis via pm.
The code:
On Activate -
Public Sub UserForm_Activate()
Set cBook = ThisWorkbook
Set dsheet = cBook.Sheets("DATA")
End Sub
Help Checkbox -
Private Sub cbHelp_Click()
If Me.cbHelp.Value = True Then
Me.lbHelp.Visible = True
Else
Me.lbHelp.Visible = False
End If
End Sub
Brand combobox -
Public Sub cmbBrand_Change()
brandTableName = cmbBrand.Value
brandTableName = CleanBrandTableName(brandTableName)
'if brand_edit is not = to a table name then error is thrown
On Error Resume Next
If Err = 380 Then
Exit Sub
Else
cmbItemID.RowSource = brandTableName
End If
On Error GoTo 0
'Set cmbItemID's text to nothing after changing to a new brand
cmbItemID.Text = ""
End Sub
CleanBrandTableName(brandTableName) function -
Option Explicit
Public Function CleanBrandTableName(ByVal brandTableName As String) As String
Dim s As Integer
Dim cleanResult As String
For s = 1 To Len(brandTableName)
Select Case Asc(Mid(brandTableName, s, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122:
cleanResult = cleanResult & Mid(brandTableName, s, 1)
Case 95
cleanResult = cleanResult & " "
Case 38
cleanResult = cleanResult & "and"
End Select
Next s
CleanBrandTableName = Replace(WorksheetFunction.Trim(cleanResult), " ", "_")
End Function
Public Function CleanSpecHyperlink(ByVal specLink As String) As String
Dim cleanLink As Variant
cleanLink = specLink
cleanLink = Replace(cleanLink, "=HYPERLINK(", "")
cleanLink = Replace(cleanLink, ")", "")
cleanLink = Replace(cleanLink, ",", "")
cleanLink = Replace(cleanLink, """", "")
cleanLink = Replace(cleanLink, "Specs", "")
CleanSpecHyperlink = cleanLink
End Function
Browse button -
Public Sub cbBrowse_Click()
Dim rPos As Long
Dim lPos As Long
Dim dPos As Long
specLinkFileName = bFile
rPos = InStrRev(specLinkFileName, "\PDFS\")
lPos = Len(specLinkFileName)
dPos = lPos - rPos
specLinkFileName = Right(specLinkFileName, dPos)
Me.tbSpecLink.Text = specLinkFileName
End Sub
bFile function -
Option Explicit
Public Function bFile() As String
bFile = Application.GetOpenFilename(Title:="Please choose a file to open")
If bFile = "" Then
MsgBox "No file selected.", vbExclamation, "Sorry!"
Exit Function
End If
End Function
Preview button -
Private Sub cbSpecs_Click()
If specLinkFileName = "" Then Exit Sub
cBook.FollowHyperlink (specLinkFileName)
End Sub
Add Item button -
Private Sub cbAddItem_Click()
Dim brand As String
Dim description As String
Dim listPrice As Currency
Dim cost As Currency
Dim Notes As String
Dim other As Variant
itemID = Me.tbNewItem.Text
brand = Me.tbBrandName.Text
description = Me.tbDescription.Text
specLink = Replace(specLinkFileName, specLinkFileName, "=HYPERLINK(""" & specLinkFileName & """,""Specs"")")
If Me.tbListPrice.Text = "" Then
listPrice = 0
Else
listPrice = Me.tbListPrice.Text
End If
If Me.tbCost.Text = "" Then
cost = 0
Else
cost = Me.tbCost.Text
End If
Notes = Me.tbNotes.Text
other = Me.tbOther.Text
If Me.lbItemList.listCount = 0 Then
x = 0
End If
With Me.lbItemList
Me.lbItemList.ColumnCount = 8
.AddItem
.List(x, 0) = itemID
.List(x, 1) = brand
.List(x, 2) = description
.List(x, 3) = specLink
.List(x, 4) = listPrice
.List(x, 5) = cost
.List(x, 6) = Notes
.List(x, 7) = other
x = x + 1
End With
End Sub
Submit button -
Private Sub cbSubmit_Click()
Dim n As Long
Dim v As Long
Dim vTable() As Variant
Dim r As Long
Dim o As Long
Dim c As Long
Dim w As Variant
Set brandTable = dsheet.ListObjects(brandTableName)
o = 1
listAmount = lbItemList.listCount
v = brandTable.ListRows.Count
w = 0
For c = 1 To listAmount
If brandTable.ListRows(v).Range(, 1).Value <> "" Then
brandTable.ListRows.Add alwaysinsert:=True
brandTable.ListRows.Add alwaysinsert:=True
Else
brandTable.ListRows.Add alwaysinsert:=True
End If
Next
ReDim vTable(1000, 1 To 10)
For n = 0 To listAmount - 1
vTable(n + 1, 1) = lbItemList.List(n, 0)
vTable(n + 1, 2) = lbItemList.List(n, 1)
vTable(n + 1, 3) = lbItemList.List(n, 2)
vTable(n + 1, 5) = lbItemList.List(n, 4)
vTable(n + 1, 6) = lbItemList.List(n, 5)
vTable(n + 1, 7) = lbItemList.List(n, 6)
vTable(n + 1, 8) = lbItemList.List(n, 7)
If lbItemList.List(n, 3) = "" Then
ElseIf lbItemList.List(n, 3) <> "" Then
vTable(n + 1, 4) = lbItemList.List(n, 3)
End If
If n = 0 And brandTable.DataBodyRange(1, 1) <> "" Then
For r = 1 To brandTable.ListRows.Count
If brandTable.DataBodyRange(r, 1) <> "" Then
o = r + 1
' brandTable.ListRows.Add alwaysinsert:=True
End If
Next
End If
brandTable.ListColumns(1).DataBodyRange(n + o).Value = vTable(n + 1, 1)
brandTable.ListColumns(2).DataBodyRange(n + o).Value = vTable(n + 1, 2)
brandTable.ListColumns(3).DataBodyRange(n + o).Value = vTable(n + 1, 3)
brandTable.ListColumns(4).DataBodyRange(n + o).Value = vTable(n + 1, 4)
brandTable.ListColumns(5).DataBodyRange(n + o).Value = vTable(n + 1, 5)
brandTable.ListColumns(6).DataBodyRange(n + o).Value = vTable(n + 1, 6)
brandTable.ListColumns(7).DataBodyRange(n + o).Value = vTable(n + 1, 7)
brandTable.ListColumns(8).DataBodyRange(n + o).Value = vTable(n + 1, 8)
Next
brandTable.DataBodyRange.Select
Selection.Font.Bold = True
Selection.WrapText = True
brandTable.ListColumns(5).DataBodyRange.Select
Selection.NumberFormat = "$#,##0.00"
brandTable.ListColumns(6).DataBodyRange.Select
Selection.NumberFormat = "$#,##0.00"
Unload Me
End Sub
Remove Items button -
Private Sub cbRemoveItems_Click()
Dim intCount As Long
For intCount = lbItemList.listCount - 1 To 0 Step -1
If lbItemList.Selected(intCount) Then
lbItemList.RemoveItem (intCount)
x = x - 1
End If
Next intCount
End Sub
There is other code that does things for the other tabs but they don't interact with this tabs code.
I'm having issues with piece of code. We use the following to search a log for a specific information, populate a chart and then print and clear the chart once completed.
The thing is, if we change the search criteria from CIS to Inbound (or anything else for that matter) it refuses to populate the chart with the information from the log, but still prints out the chart headers.
This is the code we're using:
Private Sub cmdprint_Click()
Dim sdsheet As Worksheet, ersheet As Worksheet
Set sdsheet = Workbooks("HD Project.xls").Sheets("HelpdeskLogg")
Set ersheet = Workbooks("HD Project.xls").Sheets("report")
dlr = sdsheet.Cells(Rows.Count, 1).End(xlUp).Row
rlr = ersheet.Cells(Rows.Count, 1).End(xlUp).Row
y = 2
For x = 2 To dlr
If UCase(sdsheet.Cells(x, 6)) = "Inbound" And CDate(sdsheet.Cells(x, 3)) >= CDate(Me.txtdatestart) And CDate(sdsheet.Cells(x, 3)) <= CDate(Me.txtdateend) Then
ersheet.Cells(y, 1) = CDate(sdsheet.Cells(x, 3))
ersheet.Cells(y, 2) = sdsheet.Cells(x, 6)
ersheet.Cells(y, 3) = sdsheet.Cells(x, 7)
ersheet.Cells(y, 4) = sdsheet.Cells(x, 8)
ersheet.Cells(y, 5) = sdsheet.Cells(x, 9)
ersheet.Cells(y, 6) = sdsheet.Cells(x, 10)
ersheet.Cells(y, 7) = sdsheet.Cells(x, 11)
ersheet.Cells(y, 8) = sdsheet.Cells(x, 12)
ersheet.Cells(y, 9) = sdsheet.Cells(x, 13)
y = y + 1
'On Error Resume Next
End If
Next x
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set printa = ersheet.Range("A1:i" & Lastrow)
printa.PrintOut
Sheets("report").Range("a2:i999").ClearContents
End Sub
Try changing:
UCase(sdsheet.Cells(x, 6)) = "Inbound" to
UCase(sdsheet.Cells(x, 6)) = "INBOUND"
Try changing:
UCase(sdsheet.Cells(x, 6)) = "Inbound" to
UCase(sdsheet.Cells(x, 6)) = "INBOUND"
This worked. Thank you for your help, barrleajo