Komunikacja Excela z urządzeniem zewnętrznym przez port szeregowy		strona główna: A po co ten Excel ;-)
	Temat ignoruję już od jakiegoś czasu :-P Kilka widziałem i na tym się kończy. Czemu? Najprościej powiedzieć że nie lubię teoretyzować o
	czymś czego nie widziałem jak działa. Ale odkąd nabyłem zestaw EvB4.3v4 wina "nieposiadania urządzenia" nie jest już wymówką. Trzeba
	było się w końcu tym zająć. :-)
	Zadanie jest dwu-stopniowe..
	- napisać w BasCom'ie program odczytujący z termometru DS18B20 załączonego do zestawu EvB4.3v4 i wysyłka tej informacji na port
	szeregowy w pętli co określony czas. Pomocniczo temperatura ta może wyświetlać się na Lcd zestawu.
	- przez VBA Excela odczytać z portu szeregowego te informacje i zapisywać je w kolejnych komórkach automatycznie po ich nadejściu.
	Cześć pierwszą realizuje kod..
	'----------------------------------------------------------
	'            Program odczytujący temperaturę z
	'                   termometra DS18B20
	'               Info na Wyświetlaczu LCD
	'              i wysyłane na port szeregowy
	'               tkuchta1          2012-11-15
	'                  EvB4.3v4  AtMega32 16Mh
	'
	' Wykorzystano:
	'  - PortC - wyświetlacz LCD 16*2
	'  - PortB.0 - magistrala 1wire
	'
	'----------------------------------------------------------
	$regfile = "m32def.dat"
	$crystal = 16000000
	Config Lcdpin = Pin , Db4 = Portc.5 , Db5 = Portc.4 , Db6 = Portc.3 , Db7 = Portc.2 , E = Portc.6 , Rs = Portc.7
	Config Lcd = 16 * 2
	Deflcdchar 1 , 6 , 9 , 9 , 6 , 32 , 32 , 32 , 32   'znak stopnia
	Cls
	Cursor Off Noblink
	Lcd "T:+000.00 {001}C"
	Config 1wire = Pinb.0   'konfiguracja magistrali
	Dim Lsb As Byte , Msb As Byte , T As Single , S As String * 6
	Do
	1wreset           'wysyłamy sygnał resetu i inicjalizacji magistrali
	1wwrite &HCC      'mamy podpięty tylko jeden czujnik
	'pomijamy identyfikację - wysyłamy rozkaz Skip ROM
	1wwrite &H44      'wysyłamy rozkaz Convert T, który powoduje dokonanie pomiaru
	Waitms 2000
	1wreset
	1wwrite &HCC      'pomijamy identyfikację
	1wwrite &HBE      'wysyłamy rozkaz Read scratchpad, który powoduje, że możemy odczytywać z magistrali dane
	Lsb = 1wread()    'odczytujemy niższy bajt danych
	Msb = 1wread()    'odczytujemy wyższy bajt danych
	T = Msb * 256
	T = T + Lsb
	T = T / 16         'dokonujemy konwersji danych na format tupu Single
	If Msb.7 = 1 Then T = T - 4096 'sprawdzamy bit znaku (1-liczba ujemna, 0-liczba nieujemna)
	'w przypadku liczb ujemnych dokonujemy korekty wartości
	Locate 1 , 3
	S = Fusing(t , "#.##")
	S = Format(s , "+000000") 'formatujemy dane aby były wyświetlane ze znakiem także dla wartości ujemnych
	Lcd S
	Print S
	Loop
	End
	Kod ten w 99%tach pochodzi z pomocy które można odnaleźć w sieci (przykład  z prawej). To co moje to podpięcie kabli do Lcd i termome-		Bascom i 1-Wire Elektronika Praktyczna 11.2004
	tru. Na PortC - wyświetlacz, a pod PinB.0 termometr (jednym kablem).
	Urządzenie odczytuje co zadany okres czasu (Waitms 2000) dane z termometru. Za wysyłkę odczytanej temperatury na port szeregowy
	odpowiada polecenie Print.
	Całość zapisuję na procesor zestawu i po resecie urządzenie wyświetla odczytaną temperaturę i (najprawdopodobniej) wysyła te dane na
	port szeregowy. Teraz trzeba te dane odczytać w Excelu. :-)
	szuszana " ...Kod procedury umieść w klasie UserForm.
	Jeżeli natomiast chcesz wykorzystać tę kontrolkę w kodzie, to posłuż się raczej klasą + Withevents.		pobieranie danych do excela z rs232 mscomm www.excelforum.pl
	Będziesz miał dostępne zdarzenie OnComm Event, informację o błędach…
	Jeżeli nie chcesz mieć tej Userform widocznej , spoko ukryj ją, ona będzie niczym innym jak klasą.
	I tak ją wykorzystaj, będziesz miał dostępne MSComm1_OnComm() - zgodnie z (przyjętym) nazewnictwem.
	Wszystko co chcesz zrobić napiszesz w klasie Userform…"
	Postaram się wykorzystać "klasę + Withevents"…
	- dodajemy referencję do Microsoft Comm Control 6.0
	- dodajemy moduł Class i nadajemy mu nazwę clsMSCOMM  a w nim..
	Option Explicit
	Private WithEvents objMSCOMM As MSCommLib.MSComm
	'http://support.microsoft.com/kb/194922
	Private Sub Class_Initialize()
	On Error GoTo Class_Initialize_Error
	Set objMSCOMM = New MSCommLib.MSComm
	With objMSCOMM
	.CommPort = 3
	.Handshaking = 2 - comRTS
	.RThreshold = 1
	.RTSEnable = True
	.Settings = "9600,n,8,1"
	.SThreshold = 1
	.PortOpen = True
	End With
	Class_Initialize_Exit:
	On Error Resume Next
	Exit Sub
	Class_Initialize_Error:
	Set objMSCOMM = Nothing
	MsgBox "Byk nr: - " & Err.Number & vbCrLf & vbCrLf & _
	Err.Description, vbExclamation, "VBAProject - Class_Initialize"
	Resume Class_Initialize_Exit
	End Sub
	Private Sub objMSCOMM_OnComm()
	On Error GoTo objMSCOMM_OnComm_Error
	Select Case objMSCOMM.CommEvent
	'http://msdn.microsoft.com/en-us/library/aa259389(VS.60).aspx
	' Errors
	Case comEventBreak   ' A Break was received.
	Case comEventCDTO    ' CD (RLSD) Timeout.
	Case comEventCTSTO   ' CTS Timeout.
	Case comEventDSRTO   ' DSR Timeout.
	Case comEventFrame   ' Framing Error.
	Case comEventOverrun ' Data Lost.
	Case comEventRxOver  ' Receive buffer overflow.
	Case comEventRxParity   'Parity Error.
	Case comEventTxFull  ' Transmit buffer full.
	Case comEventDCB     ' Unexpected error retrieving DCB
	' Events
	Case comEvCD   ' Change in the CD line.
	Case comEvCTS  ' Change in the CTS line.
	Case comEvDSR  ' Change in the DSR line.
	Case comEvRing ' Change in the Ring Indicator.
	Case comEvReceive: HandleInput objMSCOMM.Input ' Received RThreshold # of chars.
	Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
	Case comEvEOF  ' An EOF character was found in the
	' input stream.
	End Select
	objMSCOMM_OnComm_Exit:
	On Error Resume Next
	Exit Sub
	objMSCOMM_OnComm_Error:
	MsgBox "Byk nr: - " & Err.Number & vbCrLf & vbCrLf & _
	Err.Description, vbExclamation, "VBAProject - objMSCOMM_OnComm"
	Resume objMSCOMM_OnComm_Exit
	End Sub
	Sub HandleInput(InBuff As String)
	'https://groups.google.com/forum/?hl=pl&fromgroups=#!topic/pl.comp.lang.vbasic/PKKJ-tIp3wE
	Static sText As String: sText = sText & InBuff
	Static i As Long
	If InStr(sText, vbCrLf) > 0 Then
	i = i + 1
	Cells(i, "A") = Now()
	Cells(i, "B") = Split(sText, vbCrLf)(0)
	sText = Split(sText, vbCrLf)(1)
	End If
	End Sub
	Private Sub Class_Terminate()
	Set objMSCOMM = Nothing
	End Sub
	Co trzeba wyjaśnić żebyście mogli dostosować do swoich potrzeb:
	w zdarzeniu Class_Initialize:
	.CommPort = 3                 moje urządzenie działa na porcie Com3
	.Settings = "9600,n,8,1"     to ustawienia komunikacji określone dla urządzenia które nadaje dane
	w zdarzeniu objMSCOMM_OnComm:
	Case comEvReceive: HandleInput objMSCOMM.Input
	w zdarzeniu comEvReceive otrzymujemy dane które zostały odczytane z portu szeregowego. Tu też
	wywołuję procedurę HandleInput która wykona druga część zadania a więc zapis danych odczytanych
	z portu do komórek Excela. Czemu nie przekazuję od razu do komórek InBuff? Gdy testowałem
	przekazywanie jakichkolwiek danych na port szeregowy do testów w pętli przekazywałem dłuższe ciągi tekstowe.. Próby zapisu param.
	InBuff wprost do komórki pokazywało że zdarza się że na port trafia nie cały ciąg a jego część. Pozostała część szła np.: druga partią…
	Partie danych były rozdzielane przez vbCrLf dlatego powstała procedura która nie zwraca param. InBuff wprost do kolejnych komórek a
	zostaje zapisana do sText i do niej dopisywana do czasu pojawienia się vbCrLf. Teraz Split(sText, vbCrLf)(0) trafia do komórki a w sText
	pozostaje Split(sText, vbCrLf)(1) - pozostała cześć. Po tym manewrze dane lecą pięknie :-)
	Mod Standardowy
	Option Explicit
	Dim objMSCOMM As clsMSCOMM
	Sub Start()
	Set objMSCOMM = New clsMSCOMM
	End Sub
	Sub SStop()
	Set objMSCOMM = Nothing
	End Sub
	Mod.Thisworkbook
	Private Sub Workbook_BeforeClose(Cancel As Boolean)
	SStop
	End Sub
	Po odpaleniu Procedury Start do kolejnych komórek zapisywane są dane odczytane przez termometr :-)
	Fajne jest to że procedura nie działa w żadnej pętli czekając na pojawienie się danych w porcie. Dane są odczytywane i zapisywane do
	komórek po zdarzeniu objMSCOMM_OnComm które następuje po pojawieniu się danych tak długo jak długo w zmiennej  Dim objMSCOMM
	As clsMSCOMM jest przechowywana klasa. Po usunięciu obiektu z pamięci Set objMSCOMM = Nothing zdarzenie nie następuje choć urządzenie
	ciągle nadaje dane.
	Jak coś namieszałem - przepraszam :-P To moje pierwsze eksperymenty z takim połączeniem urządzeń. Mimo wszystko działa co na ta
	chwilę bardzo mnie cieszy.
			Do pobrania:
			term.bas (kod BasCom'a)
			rs232.zip (skoroszyt z kodem)
	PS:
	'dla UserForm przy błądzie o "Niezaufanym Żródle.. "cy cuś" o niezaufanej akcji.. Podczas dodawania kontrolki
	'Microsoft Comunication Control… powinno pomóc:
	'HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/ActiveX Compatibility/
	'{648A5600-2C6E-101B-82B6-000000000014}
	'Compatibility Flags - wartość 0