Добрый день! Прошу помощи спецов по макросам
Есть рабочий макрос смысл которого перенести информацию из EXCEL в рабочую программу,есть два варианта занести по одной или весь список,информация в ячейки попадает при помощи формул
В чем проблема!!!надо чтоб если в ячейки нет значения макрос останавливался ,как я понимаю в один из циклов в макросе (наверноInputAllReports)проверяет пустая ячейка или нет, а там формула типа IF(Zhurnal!B5<>"",Zhurnal!B5,"")и получается что она пустая только визуально и макрос переносит пустые ячейки
ниже код
Const Description_Row = 2
Const ValueMarks_Row = 3
Const Fields_Row = 4
Const Start_Row = 5
Const GlobusApplication = "FT,ACPL"
Const Start_Col = 2
Const End_Col = 16
Const ID_Col = 1
Const GlbFunction = "COMMIT"
Sub InputDeal(ByVal myrow As Long)
If Not IsEmpty(Cells(myrow, ID_Col)) Then
MsgBox ("ID is saved + " + Format(myrow))
GoTo myexit
End If
Dim Desktop As Object
Set Desktop = CreateObject("Desktop.Application")
Set MYAPP = Desktop.getApplication(GlobusApplication)
MYAPP.newid
For i = Start_Col To End_Col
'If Cells(Fields_Row, i).Value <> "" Then
fieldname = Cells(Fields_Row, i).Value
If Cells(myrow, i).Value <> "" Then
MYAPP.Value(fieldname, Cells(ValueMarks_Row, i).Value) = Cells(myrow, i).Value
End If
'End If
Next i
Cells(myrow, ID_Col).Value = MYAPP.ID
MYAPP.Commit
myexit:
End Sub
Sub InputAllReports()
tekstr = Start_Row
Do While Not IsEmpty(Cells(tekstr, Start_Col))
InputDeal (tekstr)
tekstr = tekstr + 1
Loop
End Sub
Заранее благодарю
Есть рабочий макрос смысл которого перенести информацию из EXCEL в рабочую программу,есть два варианта занести по одной или весь список,информация в ячейки попадает при помощи формул
В чем проблема!!!надо чтоб если в ячейки нет значения макрос останавливался ,как я понимаю в один из циклов в макросе (наверноInputAllReports)проверяет пустая ячейка или нет, а там формула типа IF(Zhurnal!B5<>"",Zhurnal!B5,"")и получается что она пустая только визуально и макрос переносит пустые ячейки
ниже код
Const Description_Row = 2
Const ValueMarks_Row = 3
Const Fields_Row = 4
Const Start_Row = 5
Const GlobusApplication = "FT,ACPL"
Const Start_Col = 2
Const End_Col = 16
Const ID_Col = 1
Const GlbFunction = "COMMIT"
Sub InputDeal(ByVal myrow As Long)
If Not IsEmpty(Cells(myrow, ID_Col)) Then
MsgBox ("ID is saved + " + Format(myrow))
GoTo myexit
End If
Dim Desktop As Object
Set Desktop = CreateObject("Desktop.Application")
Set MYAPP = Desktop.getApplication(GlobusApplication)
MYAPP.newid
For i = Start_Col To End_Col
'If Cells(Fields_Row, i).Value <> "" Then
fieldname = Cells(Fields_Row, i).Value
If Cells(myrow, i).Value <> "" Then
MYAPP.Value(fieldname, Cells(ValueMarks_Row, i).Value) = Cells(myrow, i).Value
End If
'End If
Next i
Cells(myrow, ID_Col).Value = MYAPP.ID
MYAPP.Commit
myexit:
End Sub
Sub InputAllReports()
tekstr = Start_Row
Do While Not IsEmpty(Cells(tekstr, Start_Col))
InputDeal (tekstr)
tekstr = tekstr + 1
Loop
End Sub
Заранее благодарю