Сообщений в теме: 27

[Zhurlena]

название темы расширено
публикуйте свои вопросы по Excel и получайте ответы, советы, рекомендации форумчан
вопросы выделяйте крупно чтобы было удобно всем (см.ниже)
---модерация---


Здравствуйте!
Помогите пожалуйста!
Мне нужно, чтобы Эксель не пересчитывал формулу только в одной ячейке.
Как это можно сделать?

В частности, чтобы при первом открытии книги в ячейку вставлялась сегодняшняя дата (функцией СЕГОДНЯ()), но при дальнейшей работе (при открытии и сохранении книги) эта формула не пересчитывалась.

[Psw]

Очевидных путей не знаю.
Но встречал (давно) - когда в шаблоне книги нарисована кнопка типа "записать", к которой привязан макрос, который заменяет нужные ячейки на их текущие значения и заодно удаляет кнопку "записать" Вполне работоспособно было.
Это возможно надо у КошакаЮвы спросить, вдруг он знает рецепт

[vidyakin]

Zhurlena (02 Февраль 2012 - 11:14) писал:

Здравствуйте!
Помогите пожалуйста!
Мне нужно, чтобы Эксель не пересчитывал формулу только в одной ячейке. Как это можно сделать?

В частности, чтобы при первом открытии книги в ячейку вставлялась сегодняшняя дата (функцией СЕГОДНЯ()), но при дальнейшей работе (при открытии и сохранении книги) эта формула не пересчитывалась.

Надо написать пару строчек на языке VBA. Какие именно строчки и где — после того, как будет ясна задача.
Стандартной функции для выполнения этой операции в Excel нет.

[Джамес Буль]

Zhurlena (02 Февраль 2012 - 11:14) писал:

В частности, чтобы при первом открытии книги в ячейку вставлялась сегодняшняя дата (функцией СЕГОДНЯ()), но при дальнейшей работе (при открытии и сохранении книги) эта формула не пересчитывалась.

Код ниже
при открытии книги проверяется ячейка B4
если она пуста туда вводится текущая дата и время
если ячейка уже содержит значение ничего не будет изменено
подправьте адрес ячейки на нужный и пользуйтсь

Private Sub Workbook_Open()
Range("B4").Select
If Excel.ActiveCell.FormulaR1C1 = "" Then ActiveCell.FormulaR1C1 = Now
End Sub

этот код нужно скопировать в вашу книгу следующим образом

• откройте нужную книгу
  
• меню tools (инструменты) \ макросы \ редактор VBA
  
• в открывшемся окне дважды кликните на "Эта книга"
  
• в открывшееся окно вставляем код
  
• подправляем адрес ячейки (B4)
  
• сохраняем книгу

файл примера прикреплен

Прикрепленные файлы

•  Book500.zip   6,38К   8 Количество загрузок:

[hren]

А зачем такая функция интересно? для контроля? тогда может защиту туда какую добавить

[Джамес Буль]

hren (10 Февраль 2012 - 15:54) писал:

А зачем такая функция интересно? для контроля? тогда может защиту туда какую добавить

обычно это требуется тем кто создает шаблоны
типо каждый новый документ при открытии шаблона получается частично заполнен и нужно тоько добавить инфы и можно отправлять

Кстати использовать шаблоны можно даже в таких простейших программах как Блокнот (notepad)
если в первой строке текстового файла написать ".LOG" (точка и большими буквами LOG без пробелов)
то при каждом открытии в конец файла будут добавлены текущая дата и время
Это можно использовать для ведения журналов

[hren]

прикольно

[Psw]

Джамес Буль (07 Февраль 2012 - 02:46) писал:

Код ниже

Дядя, а как сделать в ексельном скрипте выход из бесконечного цикла по нажатию какой-либо кнопки ?
Ну в смысле кроме Ctrl+Break
Возможно - не тока кнопки на клаве, а быть могет кнопки на рабочем листе ? Ибо запускаеццо это сейчас именно так
Текст скрипта для непрерывного пингования подсетки:

Скрытый текст

Attribute VB_Name = "Ping"
'Основа Ping взята из http://support.microsoft.com/kb/300197
Option Explicit
'Icmp constants converted from
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_pingstatus.asp
Private Const ICMP_SUCCESS As Long = 0
Private Const ICMP_STATUS_BUFFER_TO_SMALL = 11001				   'Buffer Too Small
Private Const ICMP_STATUS_DESTINATION_NET_UNREACH = 11002		   'Destination Net Unreachable
Private Const ICMP_STATUS_DESTINATION_HOST_UNREACH = 11003		  'Destination Host Unreachable
Private Const ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH = 11004	  'Destination Protocol Unreachable
Private Const ICMP_STATUS_DESTINATION_PORT_UNREACH = 11005		  'Destination Port Unreachable
Private Const ICMP_STATUS_NO_RESOURCE = 11006					   'No Resources
Private Const ICMP_STATUS_BAD_OPTION = 11007						'Bad Option
Private Const ICMP_STATUS_HARDWARE_ERROR = 11008					'Hardware Error
Private Const ICMP_STATUS_LARGE_PACKET = 11009					  'Packet Too Big
Private Const ICMP_STATUS_REQUEST_TIMED_OUT = 11010				 'Request Timed Out
Private Const ICMP_STATUS_BAD_REQUEST = 11011					   'Bad Request
Private Const ICMP_STATUS_BAD_ROUTE = 11012						 'Bad Route
Private Const ICMP_STATUS_TTL_EXPIRED_TRANSIT = 11013			   'TimeToLive Expired Transit
Private Const ICMP_STATUS_TTL_EXPIRED_REASSEMBLY = 11014			'TimeToLive Expired Reassembly
Private Const ICMP_STATUS_PARAMETER = 11015						 'Parameter Problem
Private Const ICMP_STATUS_SOURCE_QUENCH = 11016					 'Source Quench
Private Const ICMP_STATUS_OPTION_TOO_BIG = 11017					'Option Too Big
Private Const ICMP_STATUS_BAD_DESTINATION = 11018				   'Bad Destination
Private Const ICMP_STATUS_NEGOTIATING_IPSEC = 11032				 'Negotiating IPSEC
Private Const ICMP_STATUS_GENERAL_FAILURE = 11050				   'General Failure

Public Const WINSOCK_ERROR = "Windows Sockets not responding correctly."
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const WSA_SUCCESS = 0
Public Const WS_VERSION_REQD As Long = &H101

'Clean up sockets.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

'Open the socket connection.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

'Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpcreatefile.asp
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

'Convert a string that contains an (Ipv4) Internet Protocol dotted address into a correct address.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/wsapiref_4esy.asp
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) As Long

'Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpclosehandle.asp

Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long

'Information about the Windows Sockets implementation
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To 256) As Byte
   szSystemStatus(0 To 128) As Byte
   iMaxSockets As Long
   iMaxUDPDG As Long
   lpVendorInfo As Long
End Type

'Send an Internet Control Message Protocol (ICMP) echo request, and then return one or more replies.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIcmpSendEcho.asp
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
	ByVal DestinationAddress As Long, _
	ByVal RequestData As String, _
	ByVal RequestSize As Long, _
	ByVal RequestOptions As Long, _
	ReplyBuffer As ICMP_ECHO_REPLY, _
	ByVal ReplySize As Long, _
	ByVal Timeout As Long) As Long

'This structure describes the options that will be included in the header of an IP packet.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIP_OPTION_INFORMATION.asp
Private Type IP_OPTION_INFORMATION
   Ttl			 As Byte
   Tos			 As Byte
   Flags		   As Byte
   OptionsSize	 As Byte
   OptionsData	 As Long
End Type

'This structure describes the data that is returned in response to an echo request.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmp_echo_reply.asp
Public Type ICMP_ECHO_REPLY
   address		 As Long
   Status		  As Long
   RoundTripTime   As Long
   DataSize		As Long
   Reserved		As Integer
   ptrData				 As Long
   Options		As IP_OPTION_INFORMATION
   Data			As String * 250
End Type
Public Sub Form_Load() ' Надо Привязать к кнопке на раб листе, в котором будут результаты выводится.
' Модифицированный скрипт замера лага на много хостов, вывода результата цифрами и цветов в табличку,
' живые хосты пингуются значительно чаще лежащих.
' Завершение как сделать опросом клавы в бесконечном цикле не знаю - пока только по Ctrl+Break
Const TabHeght = 50, TabWight = 2, TabTop = 3, StartIp = 1, StopIp = 249, BeginIp = "10.123.231."
  Dim Reply As ICMP_ECHO_REPLY
   Dim lngSuccess As Long
   Dim strIPAddress As String
   Dim Ip, Clmn, RowIp, EchoTime, NextDownHost, TryDownTag, UpHost As Integer
   Dim A As String
MainLoop:
	Application.ScreenUpdating = True
   'Address to ping
	TryDownTag = 0
	Cells(TabTop, 2).Value = NextDownHost
	Cells(TabTop, 1).Value = UpHost
	'A = inkey()
	Application.ScreenUpdating = False
	UpHost = 0
	For Ip = StartIp To StopIp
	  strIPAddress = BeginIp & Trim(Str(Ip))
	  Clmn = Int(Ip / TabHeght): RowIp = Ip - Clmn * TabHeght
   If Len(Cells(RowIp + TabTop, Clmn * TabWight + 2).Value) < 3 Or (TryDownTag = 0 And Ip >= NextDownHost) Then
	 If Len(Cells(RowIp + TabTop, Clmn * TabWight + 2).Value) > 2 Then
		TryDownTag = 1
		NextDownHost = Ip + 1
		If NextDownHost > StopIp Then NextDownHost = StartIp
	 End If


   'Get the sockets ready.
   If SocketsInitialize() Then


	'Ping the IP that is passing the address and get a reply.
	lngSuccess = ping(strIPAddress, Reply)

	'Display the results.
	Cells(RowIp + TabTop, Clmn * TabWight + 1).Value = Ip

	If Len(Str(Reply.RoundTripTime)) > 3 Then
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Value = "---"
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
	Else
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Value = Val(Reply.RoundTripTime)
		UpHost = UpHost + 1
	Select Case Reply.RoundTripTime
	Case 0
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
	Case 1 To 4
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = 35
	Case 5 To 9
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
	Case 10 To 20
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = 6
	Case Else
		Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
	End Select

	End If


	'A = "Address to Ping: " & strIPAddress
	'A = A & ", Raw ICMP code: " & lngSuccess
	'A = A & ", Ping Response Message : " & EvaluatePingResponse(lngSuccess)
	'A = A & ", Time : " & Reply.RoundTripTime & " ms"
	'If MsgBox(A, vbOKCancel, "Ping Results") = vbCancel Then Stop

	'Clean up the sockets.
	SocketsCleanup

   Else

   'Winsock error failure, initializing the sockets.
   'A = 1
   If MsgBox(WINSOCK_ERROR, vbOKCancel, "Ошибка WinSock при инициализации Socket") = vbCancel Then Stop


   End If
   End If
   Next Ip
GoTo MainLoop
End Sub


'-- Ping a string representation of an IP address.
' -- Return a reply.
' -- Return long code.
Public Function ping(sAddress As String, Reply As ICMP_ECHO_REPLY) As Long

Dim hIcmp As Long
Dim lAddress As Long
Dim lTimeOut As Long
Dim StringToSend As String

'Short string of data to send
StringToSend = "Hello Host, Please Fastest Replay for network testings"

'ICMP (ping) timeout
lTimeOut = 50 'ms

'Convert string address to a long representation.
lAddress = inet_addr(sAddress)

If (lAddress <> -1) And (lAddress <> 0) Then

	'Create the handle for ICMP requests.
	hIcmp = IcmpCreateFile()

	If hIcmp Then
		'Ping the destination IP address.
		Call IcmpSendEcho(hIcmp, lAddress, StringToSend, Len(StringToSend), 0, Reply, Len(Reply), lTimeOut)

		'Reply status
		ping = Reply.Status

		'Close the Icmp handle.
		IcmpCloseHandle hIcmp
	Else
		'Debug.Print "failure opening icmp handle."
		If MsgBox("failure opening icmp handle.", vbOKCancel, "Ping Faults") = vbCancel Then Stop
		ping = -1
	End If
Else
	ping = -1
End If

End Function

'Clean up the sockets.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Sub SocketsCleanup()

   WSACleanup

End Sub

'Get the sockets ready.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA

   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = ICMP_SUCCESS

End Function

'Convert the ping response to a message that you can read easily from constants.
'For more information about these constants, visit the following Microsoft Web site:
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_pingstatus.asp

Public Function EvaluatePingResponse(PingResponse As Long) As String

  Select Case PingResponse

  'Success
  Case ICMP_SUCCESS: EvaluatePingResponse = "Success!"

  'Some error occurred
  Case ICMP_STATUS_BUFFER_TO_SMALL:	EvaluatePingResponse = "Buffer Too Small"
  Case ICMP_STATUS_DESTINATION_NET_UNREACH: EvaluatePingResponse = "Destination Net Unreachable"
  Case ICMP_STATUS_DESTINATION_HOST_UNREACH: EvaluatePingResponse = "Destination Host Unreachable"
  Case ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH: EvaluatePingResponse = "Destination Protocol Unreachable"
  Case ICMP_STATUS_DESTINATION_PORT_UNREACH: EvaluatePingResponse = "Destination Port Unreachable"
  Case ICMP_STATUS_NO_RESOURCE: EvaluatePingResponse = "No Resources"
  Case ICMP_STATUS_BAD_OPTION: EvaluatePingResponse = "Bad Option"
  Case ICMP_STATUS_HARDWARE_ERROR: EvaluatePingResponse = "Hardware Error"
  Case ICMP_STATUS_LARGE_PACKET: EvaluatePingResponse = "Packet Too Big"
  Case ICMP_STATUS_REQUEST_TIMED_OUT: EvaluatePingResponse = "Request Timed Out"
  Case ICMP_STATUS_BAD_REQUEST: EvaluatePingResponse = "Bad Request"
  Case ICMP_STATUS_BAD_ROUTE: EvaluatePingResponse = "Bad Route"
  Case ICMP_STATUS_TTL_EXPIRED_TRANSIT: EvaluatePingResponse = "TimeToLive Expired Transit"
  Case ICMP_STATUS_TTL_EXPIRED_REASSEMBLY: EvaluatePingResponse = "TimeToLive Expired Reassembly"
  Case ICMP_STATUS_PARAMETER: EvaluatePingResponse = "Parameter Problem"
  Case ICMP_STATUS_SOURCE_QUENCH: EvaluatePingResponse = "Source Quench"
  Case ICMP_STATUS_OPTION_TOO_BIG: EvaluatePingResponse = "Option Too Big"
  Case ICMP_STATUS_BAD_DESTINATION: EvaluatePingResponse = "Bad Destination"
  Case ICMP_STATUS_NEGOTIATING_IPSEC: EvaluatePingResponse = "Negotiating IPSEC"
  Case ICMP_STATUS_GENERAL_FAILURE: EvaluatePingResponse = "General Failure"

  'Unknown error occurred
  Case Else: EvaluatePingResponse = "Unknown Response"

  End Select

End Function

---модерация---
вопрос выделен крупно после реорганизации темы

[Джамес Буль]

Psw (21 Март 2012 - 12:52) писал:

Дядя, а как сделать в ексельном скрипте выход из бесконечного цикла по нажатию какой-либо кнопки ?
Ну в смысле кроме Ctrl+Break
Возможно - не тока кнопки на клаве, а быть могет кнопки на рабочем листе ? Ибо запускаеццо это сейчас именно так
Текст скрипта для непрерывного пингования подсетки:

имхо бесконечный цикл это всегда плохо

в экселе есть функция:
Application.OnTime время, название процедуры

вот пример из справки:
Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure"
запустить через 15 секунд процедуру my_Procedure

Механизм такой:
В конце выполнения процедуры my_Procedure
повторяем вызов Application.OnTime со ссылкой на имя текущей процедуры
но этот вызов предворяем проверкой условия нажатия кнопки
например кнопка при нажатии устанавливает значение переменной NowStop=vbTrue
тогда:
if NowStop=vbFalse then Application.OnTime Now + TimeValue("00:00:05"), "my_Procedure"

В итоге процедура будет запускаться каждые 5 секунд если не была нажата кнопка
при нажатии кнопки текущая выполняемая процедура спокойно выполняется до конца но следующего запуска уже не будет

[Psw]

Ничего не понял на спех Зачем мне по времени шедулить если я могу прямо в бесконечный циклер (номинальная скорость порядка секунды на оборот) вставить опрос события (нажатия кнопки на клаве или раб листе) ?
Проблема в том что выполняющийся VBA скрипт вешает эхель мёртво и тот не осознаёт что были клики мыши по кнопам
Нужен аналог басицной inkey$, даже если и с ограничениями - что будет ловить клики/нажатия тока в модальном окне - дань мелкомягкому не отягощает И даже приветствуется ...
Прочитал ещё раз.
Ты думаешь что Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" будет запускаться в отдельном потоке ?
Мне другой знакомец тоже предложил ковырять многопоточность, но на мой взгляд - непонятно нахрена она нужна если я и в основном циклере могу опрашивать события, важно кто их будет порождать и как я их буду получать в скрипт VBA ?
Короче ты не мог бы опробовать своё предложение, я же текст приложил скрипта полный ?
А по поводу "бесконечные циклы=зло" - ядро любой много задачной операционки или проги - бесконечный циклер Так что ... Мы все злые
Начало бесконечного циклера - 111 строка приложенного скрипта.

[Джамес Буль]

Psw (21 Март 2012 - 21:23) писал:

Ничего не понял на спех Зачем мне по времени шедулить если я могу прямо в бесконечный циклер (номинальная скорость порядка секунды на оборот) вставить опрос события (нажатия кнопки на клаве или раб листе) ?
Проблема в том что выполняющийся VBA скрипт вешает эхель мёртво и тот не осознаёт что были клики мыши по кнопам

ответ на вопрос подчеркнут
Это Виндофс
Если используется зацикливание то процесс выбирает столько ресурсов системы сколько она позволяет (зависит от версии виндовс и множества других факторов)
а это может быть и 100 процентов и тогда будет практически полный висяк
поэтому я и написал что зацикливание это зло

Если процесс работает по времени то ожидание следующего запуска не требует выделения системой значительных ресурсов
и эти ресурсы отдаются другим программам либо просто не расходуются и система ждет "что хотите хозяин?"
и это правильный подход

Система всеравно не сможет выполнить свои задачи быстрее при зацикливании
потому при зацикливании просто паузы между повторами теоретически равны 0 а на самом деле
при вызове по времени если не делать паузы совсем микроскопическими достигается баланс между скорострельностью программы и требами системы

Psw (21 Март 2012 - 21:23) писал:

Ты думаешь что Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" будет запускаться в отдельном потоке ?

нет я такого не говорил
поток он один
разделение на потоки делается совсем по другому а в данной задаче оно ваще не нужно

Psw (21 Март 2012 - 21:23) писал:

Мне другой знакомец тоже предложил ковырять многопоточность, но на мой взгляд - непонятно нахрена она нужна если я и в основном циклере могу опрашивать события, важно кто их будет порождать и как я их буду получать в скрипт VBA ?
Короче ты не мог бы опробовать своё предложение, я же текст приложил скрипта полный ?

я OnTime использовал в некоторых задачах все там нормально
ваще если тебе нужно пинговать я не совсем понимаю нафига ваще нужен excel
обычный VBS (vbscript) примеры в сети найти можно готовые

Psw (21 Март 2012 - 21:23) писал:

А по поводу "бесконечные циклы=зло" - ядро любой много задачной операционки или проги - бесконечный циклер Так что ... Мы все злые

видишли то что ты называешь бесконечные циклы и то что приводишь в качестве примера inkey$
это реализуется в системе не совсем одинаково и последствия поэтому разные
в одном случае прога зажирает все ресурсы и тупо все начинает тормозить в другом случае цикл на языке высокого уровня проработан челами которые делают компиляторы и интерпретаторы так что на самом деле для операционки зацикливания нету
если ты будешь писать на низком уровне тогда можно спорить и рассуждать а код на VBA тут лучше не ходить на грабли по которым толпы уже ходили
в данном случае ты просишь Excel выполнить для тебя код VBA а там дальше такая начинается какафония лучше просто не вникать

[Psw]

Джамес Буль (22 Март 2012 - 00:55) писал:

ваще если тебе нужно пинговать я не совсем понимаю нафига ваще нужен excel
обычный VBS (vbscript) примеры в сети найти можно готовые

Ехель - привычен просто, лублу я его А васик-скрипты там вполне просто приделаны.
Ну хочеццо в потенциале долговременно хранить/обрабатывать результаты отклика. Кроме того, хочеццо знать например скока хостов реально существуют в подсетке, ибо списки DHCP сервака не актуальны По разным причинам ...
Сейчас торможу скрипт Ctrl+Break и при ScreenUpdating=False экран эхеля при выходе из скрипта не подвисает, в отличие от прежних версий эхеля. Так что быть могет мой вопрос из практических перешёл в категорию чисто эстетических

[Джамес Буль]

тада ага
я сам люблю экселю причем с версии гдето 4
в то время это была самая чудесная программа которую я встретил

а ваще одно дело для себя а другое дело для клиента писать
писать для клиентов на VBA я зарекся давно
стрем разных версий и зависимость от особенностей конфигурации конкретного компа убивает всю идею
но как малая подручная автоматизация вполне ничо

[Глум]

Psw сказал:

Текст скрипта для непрерывного пингования подсетки:

Извиняюсь за оффтоп злостный.
ПСВ, а как твоя прога реагирует, если машинка в подсети дропит пинги?

ПМСМ, для целей пинга локалки, да и не только, вполне себе ничего работает nmap. Задаёшь ему дипазон, задаёшь не сканить порты, а только пинговать, отправляешь результаты в файл. Всё - одна строка в консоли.
А уж из файла парси отчёты, как тебе угодно.

ЗЫ А зачем подсеть пинговать непрерывно? DDoS-ишь?

[Кошак Юва]

Psw (21 Март 2012 - 21:23) писал:

Проблема в том что выполняющийся VBA скрипт вешает эхель мёртво

DoEvents( )
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
перевод приблизительно такой - передает управление ОС, чтобы та могла отработать другие события...Затем управление возвращается. Я - пользуюсь, помогает

[Кошак Юва]

Zhurlena (02 Февраль 2012 - 11:14) писал:

Мне нужно, чтобы Эксель не пересчитывал формулу только в одной ячейке. Как это можно сделать?
В частности, чтобы при первом открытии книги в ячейку вставлялась сегодняшняя дата (функцией СЕГОДНЯ()), но при дальнейшей работе (при открытии и сохранении книги) эта формула не пересчитывалась.

формула в ячейке "блокируется" содержимым другой ячейки, к примеру, ячейкой с именем Created_Date (=$B$5, к примеру, если не нравится работать с именованными ячейками):
=ЕСЛИ(ЕПУСТО(Created_Date);СЕГОДНЯ();Created_Date)

[Джамес Буль]

Кошак Юва (22 Март 2012 - 19:47) писал:

DoEvents( )
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
перевод приблизительно такой - передает управление ОС, чтобы та могла отработать другие события...Затем управление возвращается. Я - пользуюсь, помогает

doevents v VBA криво реализована это означает что поведение скрипта в разных версиях Excel и на разных ПК может сильно отличаться
да и ограничение серьезное есть связанное что в момент работы скрипта ничто другое не должно "мешать"
(майкрософты откровенно признают это в справке) (например обработка события может все подвесить)
на практике выжирает ресурсов много больше чем нужно для выполнения задачи
а в чудесных сочетаниях с другим софтом прекрасно тормозит всю систему

впрочем если скрипт предполагается использовать только на текущем пк то можно поступить по правилу "если работает то и ладно"

[Psw]

Глум (22 Март 2012 - 18:47) писал:

ПСВ, а как твоя прога реагирует, если машинка в подсети дропит пинги?

Если хост не отвечает - значит он лежит Подсетка внутренняя, эхо ответ везде разрешён политиками.

Глум (22 Март 2012 - 18:47) писал:

ПМСМ, для целей пинга локалки, да и не только, вполне себе ничего работает nmap. Задаёшь ему дипазон, задаёшь не сканить порты, а только пинговать, отправляешь результаты в файл. Всё - одна строка в консоли.
А уж из файла парси отчёты, как тебе угодно.

ХЗ, давно мечтал пинговать прям из эхеля, вот наткнулсо - прикольно, работает
Вызывать внешнюю прогу - тока путь удлиннять.
Как мне например построить график времени отклика от времени суток сотни хостов в подсетке ? А в эхеле смогу ....

Глум (22 Март 2012 - 18:47) писал:

ЗЫ А зачем подсеть пинговать непрерывно? DDoS-ишь?

Моя подсетка - что хочу то и делаю Зря штоле гигабитные свичи киловаты жуют ?

Кошак Юва (22 Март 2012 - 19:47) писал:

DoEvents( )
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
перевод приблизительно такой - передает управление ОС, чтобы та могла отработать другие события...Затем управление возвращается. Я - пользуюсь, помогает

Про это мне знакомец уже намекнул. Сопроводив каментом что КПД упадёт ибо "DoEvents сильно жрёт ресурсы"
Кароче - попробовал - ничего не изменилось. Что я делаю не так ? Текущая версия скрипта:

Скрытый текст

Attribute VB_Name = "Ping"
'Основа Ping взята из http://support.microsoft.com/kb/300197
Option Explicit
'Icmp constants converted from
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_pingstatus.asp
Private Const ICMP_SUCCESS As Long = 0
Public Const WINSOCK_ERROR = "Windows Sockets not responding correctly."
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const WSA_SUCCESS = 0
Public Const WS_VERSION_REQD As Long = &H101
Dim DoStopTag As Integer

'Clean up sockets.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

'Open the socket connection.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

'Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpcreatefile.asp
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

'Convert a string that contains an (Ipv4) Internet Protocol dotted address into a correct address.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/wsapiref_4esy.asp
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) As Long

'Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpclosehandle.asp

Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long

'Information about the Windows Sockets implementation
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To 256) As Byte
   szSystemStatus(0 To 128) As Byte
   iMaxSockets As Long
   iMaxUDPDG As Long
   lpVendorInfo As Long
End Type

'Send an Internet Control Message Protocol (ICMP) echo request, and then return one or more replies.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIcmpSendEcho.asp
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
   (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Long, _
    ByVal RequestOptions As Long, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long

'This structure describes the options that will be included in the header of an IP packet.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIP_OPTION_INFORMATION.asp
Private Type IP_OPTION_INFORMATION
   Ttl             As Byte
   Tos             As Byte
   Flags           As Byte
   OptionsSize     As Byte
   OptionsData     As Long
End Type

'This structure describes the data that is returned in response to an echo request.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmp_echo_reply.asp
Public Type ICMP_ECHO_REPLY
   address         As Long
   Status          As Long
   RoundTripTime   As Long
   DataSize        As Long
   Reserved        As Integer
   ptrData                 As Long
   Options        As IP_OPTION_INFORMATION
   Data            As String * 250
End Type
Public Sub Form_Stop() ' Привязан к кнопе "СТОП" на раб листе.
DoStopTag = 1           ' Эта переменная будет общей для всех саб прог в данном модуле ?
End Sub
Public Sub Form_Load() ' Надо Привязать к кнопке на раб листе, в котором будут результаты выводится.
' Модифицированный скрипт замера лага на много хостов, вывода результата цифрами и цветов в табличку,
' живые хосты пингуются значительно чаще лежащих.
' Завершение как сделать опросом клавы в бесконечном цикле не знаю - пока только по Ctrl+Break
Const TabHeght = 50, TabWight = 2, TabTop = 3, StartIp = 1, StopIp = 249, BeginIp = "10.123.231."
  Dim Reply As ICMP_ECHO_REPLY
   Dim lngSuccess As Long
   Dim strIPAddress As String
   Dim Ip, Clmn, RowIp, EchoTime, NextDownHost, TryDownTag, UpHost, Evnt As Integer
   Dim A As String
   DoStopTag = 0
MainLoop:
    Evnt = DoEvents()
    Application.ScreenUpdating = True
    If DoStopTag > 0 Then GoTo ExitSub
   'Address to ping
    TryDownTag = 0
    Cells(TabTop, 2).Value = NextDownHost
    Cells(TabTop, 1).Value = UpHost
    'A = inkey()
    Application.ScreenUpdating = False
    UpHost = 0
    For Ip = StartIp To StopIp
      strIPAddress = BeginIp & Trim(Str(Ip))
      Clmn = Int(Ip / TabHeght): RowIp = Ip - Clmn * TabHeght
   If Len(Cells(RowIp + TabTop, Clmn * TabWight + 2).Value) < 3 Or (TryDownTag = 0 And Ip >= NextDownHost) Then
     If Len(Cells(RowIp + TabTop, Clmn * TabWight + 2).Value) > 2 Then
        TryDownTag = 1
        NextDownHost = Ip + 1
        If NextDownHost > StopIp Then NextDownHost = StartIp
     End If


   'Get the sockets ready.
   If SocketsInitialize() Then


    'Ping the IP that is passing the address and get a reply.
    lngSuccess = ping(strIPAddress, Reply)

    'Display the results.
    Cells(RowIp + TabTop, Clmn * TabWight + 1).Value = Ip

    If Len(Str(Reply.RoundTripTime)) > 3 Then
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Value = "___"
        'Cells(RowIp + TabTop, Clmn * TabWight + 2).ClearContents
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
    Else
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Value = Val(Reply.RoundTripTime)
        UpHost = UpHost + 1
    Select Case Reply.RoundTripTime
    Case 0
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
    Case 1 To 4
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = 35
    Case 5 To 9
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
    Case 10 To 20
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = 6
    Case Else
        Cells(RowIp + TabTop, Clmn * TabWight + 2).Interior.ColorIndex = xlNone
    End Select

    End If


    'A = "Address to Ping: " & strIPAddress
    'A = A & ", Raw ICMP code: " & lngSuccess
    'A = A & ", Ping Response Message : " & EvaluatePingResponse(lngSuccess)
    'A = A & ", Time : " & Reply.RoundTripTime & " ms"
    'If MsgBox(A, vbOKCancel, "Ping Results") = vbCancel Then GoTo ExitSub

    'Clean up the sockets.
    SocketsCleanup

   Else

   'Winsock error failure, initializing the sockets.
   'A = 1
   If MsgBox(WINSOCK_ERROR, vbOKCancel, "Ошибка WinSock при инициализации Socket") = vbCancel Then GoTo ExitSub


   End If
   End If
   Next Ip
GoTo MainLoop
ExitSub:
End Sub


'-- Ping a string representation of an IP address.
' -- Return a reply.
' -- Return long code.
Public Function ping(sAddress As String, Reply As ICMP_ECHO_REPLY) As Long

Dim hIcmp As Long
Dim lAddress As Long
Dim lTimeOut As Long
Dim StringToSend As String

'Short string of data to send
StringToSend = "Hello Host, Please Fastest Replay for network testings"

'ICMP (ping) timeout
lTimeOut = 50 'ms

'Convert string address to a long representation.
lAddress = inet_addr(sAddress)

If (lAddress <> -1) And (lAddress <> 0) Then

    'Create the handle for ICMP requests.
    hIcmp = IcmpCreateFile()

    If hIcmp Then
        'Ping the destination IP address.
        Call IcmpSendEcho(hIcmp, lAddress, StringToSend, Len(StringToSend), 0, Reply, Len(Reply), lTimeOut)

        'Reply status
        ping = Reply.Status

        'Close the Icmp handle.
        IcmpCloseHandle hIcmp
    Else
        'Debug.Print "failure opening icmp handle."
        If MsgBox("failure opening icmp handle.", vbOKCancel, "Ping Faults") = vbCancel Then Stop
        ping = -1
    End If
Else
    ping = -1
End If

End Function

'Clean up the sockets.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Private Sub SocketsCleanup()

   WSACleanup

End Sub

'Get the sockets ready.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA

   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = ICMP_SUCCESS

End Function

'Convert the ping response to a message that you can read easily from constants.
'For more information about these constants, visit the following Microsoft Web site:
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_pingstatus.asp

Public Function EvaluatePingResponse(PingResponse As Long) As String

Private Const ICMP_STATUS_BUFFER_TO_SMALL = 11001                   'Buffer Too Small
Private Const ICMP_STATUS_DESTINATION_NET_UNREACH = 11002           'Destination Net Unreachable
Private Const ICMP_STATUS_DESTINATION_HOST_UNREACH = 11003          'Destination Host Unreachable
Private Const ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH = 11004      'Destination Protocol Unreachable
Private Const ICMP_STATUS_DESTINATION_PORT_UNREACH = 11005          'Destination Port Unreachable
Private Const ICMP_STATUS_NO_RESOURCE = 11006                       'No Resources
Private Const ICMP_STATUS_BAD_OPTION = 11007                        'Bad Option
Private Const ICMP_STATUS_HARDWARE_ERROR = 11008                    'Hardware Error
Private Const ICMP_STATUS_LARGE_PACKET = 11009                      'Packet Too Big
Private Const ICMP_STATUS_REQUEST_TIMED_OUT = 11010                 'Request Timed Out
Private Const ICMP_STATUS_BAD_REQUEST = 11011                       'Bad Request
Private Const ICMP_STATUS_BAD_ROUTE = 11012                         'Bad Route
Private Const ICMP_STATUS_TTL_EXPIRED_TRANSIT = 11013               'TimeToLive Expired Transit
Private Const ICMP_STATUS_TTL_EXPIRED_REASSEMBLY = 11014            'TimeToLive Expired Reassembly
Private Const ICMP_STATUS_PARAMETER = 11015                         'Parameter Problem
Private Const ICMP_STATUS_SOURCE_QUENCH = 11016                     'Source Quench
Private Const ICMP_STATUS_OPTION_TOO_BIG = 11017                    'Option Too Big
Private Const ICMP_STATUS_BAD_DESTINATION = 11018                   'Bad Destination
Private Const ICMP_STATUS_NEGOTIATING_IPSEC = 11032                 'Negotiating IPSEC
Private Const ICMP_STATUS_GENERAL_FAILURE = 11050                   'General Failure

  Select Case PingResponse

  'Success
  Case ICMP_SUCCESS: EvaluatePingResponse = "Success!"

  'Some error occurred
  Case ICMP_STATUS_BUFFER_TO_SMALL:    EvaluatePingResponse = "Buffer Too Small"
  Case ICMP_STATUS_DESTINATION_NET_UNREACH: EvaluatePingResponse = "Destination Net Unreachable"
  Case ICMP_STATUS_DESTINATION_HOST_UNREACH: EvaluatePingResponse = "Destination Host Unreachable"
  Case ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH: EvaluatePingResponse = "Destination Protocol Unreachable"
  Case ICMP_STATUS_DESTINATION_PORT_UNREACH: EvaluatePingResponse = "Destination Port Unreachable"
  Case ICMP_STATUS_NO_RESOURCE: EvaluatePingResponse = "No Resources"
  Case ICMP_STATUS_BAD_OPTION: EvaluatePingResponse = "Bad Option"
  Case ICMP_STATUS_HARDWARE_ERROR: EvaluatePingResponse = "Hardware Error"
  Case ICMP_STATUS_LARGE_PACKET: EvaluatePingResponse = "Packet Too Big"
  Case ICMP_STATUS_REQUEST_TIMED_OUT: EvaluatePingResponse = "Request Timed Out"
  Case ICMP_STATUS_BAD_REQUEST: EvaluatePingResponse = "Bad Request"
  Case ICMP_STATUS_BAD_ROUTE: EvaluatePingResponse = "Bad Route"
  Case ICMP_STATUS_TTL_EXPIRED_TRANSIT: EvaluatePingResponse = "TimeToLive Expired Transit"
  Case ICMP_STATUS_TTL_EXPIRED_REASSEMBLY: EvaluatePingResponse = "TimeToLive Expired Reassembly"
  Case ICMP_STATUS_PARAMETER: EvaluatePingResponse = "Parameter Problem"
  Case ICMP_STATUS_SOURCE_QUENCH: EvaluatePingResponse = "Source Quench"
  Case ICMP_STATUS_OPTION_TOO_BIG: EvaluatePingResponse = "Option Too Big"
  Case ICMP_STATUS_BAD_DESTINATION: EvaluatePingResponse = "Bad Destination"
  Case ICMP_STATUS_NEGOTIATING_IPSEC: EvaluatePingResponse = "Negotiating IPSEC"
  Case ICMP_STATUS_GENERAL_FAILURE: EvaluatePingResponse = "General Failure"

  'Unknown error occurred
  Case Else: EvaluatePingResponse = "Unknown Response"

  End Select

End Function

[Глум]

Psw сказал:

Как мне например построить график времени отклика от времени суток сотни хостов в подсетке ?

Сверхзадача непонятна. Особенно если

Цитата

Если хост не отвечает - значит он лежит эхо ответ везде разрешён политиками.

А в чём важность непрерывной доступности каждого хоста? Провайдер что ле? Если одмин - утром позвонят с этого хоста: "Ничо не работаит!".
Поставь нмап на шедул.
Пингуешь тоже изнутри?

Цитата

ХЗ, давно мечтал пинговать прям из эхеля, вот наткнулсо - прикольно, работает

ХЗ, я б с калькулятра или косынки попробовал. Тоже прикольно, наверное.

[Psw]

Глум (22 Март 2012 - 18:47) писал:

Извиняюсь за оффтоп злостный.

Кстати если вдруг модератор задним числом пере именует тему в что-либо типа "MS Excel - вопросы, проблемы и решения" - то тема себя долго смогет не исчерпать

Глум (23 Март 2012 - 00:09) писал:

А в чём важность непрерывной доступности каждого хоста?

Скорее - время отклика живых и быстрых хостов, которые 0-5 мСек лаг имеют. Сам ещё не знаю зачем Стат обработка данных показала, что она была бесполезной

Глум (23 Март 2012 - 00:09) писал:

Поставь нмап на шедул.

Из этого скрипта сейчас чуть более сотни живых хостов пингуются пару/тройку раз за сек, и пара/тройка лежачих проверяются на лежачесть - соответственно картина вкл/выкл каждого конкретного хоста не особо меняет/портит частоту оборотов главного циклера.
НМАП позволяет сделать тайм-аут 50 мСек ? Даже если и так, то шедулить его даже если каждую секунду - не изврат ли ?
Пока не вижу необходимости. Недостаток васика в том что его приходится брэйком останавливать - не значительный для лично меня.
Кстати после добавления DoEvents() в главный циклер (вызывается 2-3 раза в сек) загрузка проца вроде не возросла. Но и не помогло останавливать "кнопкой".

Глум (23 Март 2012 - 00:09) писал:

Пингуешь тоже изнутри?

Ясное дело По интернетам ловить лаги 0-5 мСек нереально.

[Джамес Буль]

название темы расширено
надеюсь автор темы непротиф
вопросы выделяйте жирно и крупно тада будет удобнее всем
---модерация---

[Кошак Юва]

Psw (22 Март 2012 - 22:40) писал:

Что я делаю не так ? Текущая версия скрипта:

я ставлю DoEvents всегда после вызова любых функций на ассемблере (то, что грузит процессор) или старта внешних программ (использую обычно Access). При старте "длинных" операций (фоновые пересчеты базы или обработка файлов) фокус остается на стартующей кнопке - обрабатываю событие нажатия клавиши, проверяя, не нажал ли оператор ESC (это отмена операции). Если нажал - взводится триггер-переменная, которая анализируется в каждом цикле. Работает на базах в 100-200тыс файлов, компы Целероны в т.ч.
Если нужен код - только попросите, там десяток строк

[Кошак Юва]

Цитата

Что я делаю не так ?

стормозил, допишу здесь... Psw, у тебя нет обработчика клавиши ESC (то есть отмены операции) - ну, тогда Excel'ю можно прекратить работу только по Ctrl+Breake, что, собственно, и происходит....DoEvents отдает управление другим обработчикам (мало ли что ты пускаешь параллельно со сканированием сети - при этом надо, чтобы комп на клавиши реагировал). Такое перебрасывание ресурсов процессора, естественно, шустроты программе не добавляет (о чем и писал Джамес Буль) - так оно и не надо вроде. Надо, чтобы программа максимум за цикл опроса одного хоста отреагировала, когда юзер нажмет на отмену операции

[Psw]

Кошак Юва (23 Март 2012 - 19:50) писал:

фокус остается на стартующей кнопке - обрабатываю событие нажатия клавиши, проверяя, не нажал ли оператор ESC (это отмена операции). Если нажал - взводится триггер-переменная, которая анализируется в каждом цикле.
<>
Если нужен код - только попросите, там десяток строк

Дядя, Дай кода Вставлю. Именно это я и спрашивал - как опрашивать нажатия кнопок в скрипте не останавливая выполнение скрипта (аналог бэйсик inkey$ ) . Ибо inputbox будет ждать реакции человека.
Как при выполнении скрипта узнать что чел давил эскейп к примеру или мышой кликал по формам ?

Кошак Юва (23 Март 2012 - 23:28) писал:

Надо, чтобы программа максимум за цикл опроса одного хоста отреагировала, когда юзер нажмет на отмену операции

Именно. Дайте кода Который я всталю хоть перед каждым пингом, нет проблем.
Кстати гугель показал что такой вопрос существует не тока у меня

[Кошак Юва]

Psw (24 Март 2012 - 10:03) писал:

Как при выполнении скрипта узнать что чел давил эскейп к примеру или мышой кликал по формам ?

обрабатывай события "нажатие на клавишу" (OnKeyDown) для своей кнопки "Выполнить" (ибо фокус остаётся на ней при нажатии мышой) и событие OnClick для формы. NB! Если ты не прерываешь цикл с помощью DoEvents, твои нажатия остаются в очереди до выхода из цикла - то есть навсегда или до Ctrl+Break.Код ушел в личку, если считаешь полезным - выложи сюда всем.
ЗЫ вообще-то я принудительно перед запуском счета ставлю фокус на кнопку Cancel и обрабатываю события на ней - оператор может нажать кнопку пробелом, мышой или нажать ESC на клавиатуре, но текст проги несколько запутывается... Тебе послал простой вариант.