½éÉÜ

Application.ActiveDocument.SaveAs ("New Document Name.docx")

VBA·¶Àý

±àÂë

CANlib API- ºÍ¾ä±úÉùÃ÷

Option Explicit 'Force explicit variable declaration so that an undeclared variable generates error.
 
 
#If VBA7 Then
  Private Declare PtrSafe Sub canInitializeLibrary Lib "CANLIB32.DLL" ()
  Private Declare PtrSafe Function canUnloadLibrary Lib "CANLIB32.DLL" () As Long
  Private Declare PtrSafe Function canGetNumberOfChannels Lib "CANLIB32.DLL" (ByRef channelCount As Long) As Long
  Private Declare PtrSafe Function canGetChannelData Lib "CANLIB32.DLL" (ByVal channel As Long, ByVal item As Long, ByRef buffer As Any, ByVal bufsize As Long) As Long
  Private Declare PtrSafe Function canOpenChannel Lib "CANLIB32.DLL" (ByVal handle As Long, ByVal Flags As Long) As LongPtr
  Private Declare PtrSafe Function canClose Lib "CANLIB32.DLL" (ByVal handle As LongPtr) As Long
  Private Declare PtrSafe Function canBusOn Lib "CANLIB32.DLL" (ByVal handle As LongPtr) As Long
  Private Declare PtrSafe Function canBusOff Lib "CANLIB32.DLL" (ByVal handle As LongPtr) As Long
  Private Declare PtrSafe Function canSetBusParams Lib "CANLIB32.DLL" (ByVal handle As LongPtr, ByVal freq As Long, ByVal tseg1 As Long, ByVal tseg2 As Long, ByVal sjw As Long, ByVal noSamp As Long, ByVal syncMode As Long) As Long
  Private Declare PtrSafe Function canWrite Lib "CANLIB32.DLL" (ByVal handle As LongPtr, ByVal id As Long, ByRef msg As Any, ByVal dlc As Long, ByVal flag As Long) As Long
  Private Declare PtrSafe Function canReadWait Lib "CANLIB32.DLL" (ByVal handle As LongPtr, ByRef id As Long, ByRef msg As Any, ByRef dlc As Long, ByRef flag As Long, ByRef time As Long, ByRef timeout As Long) As Long
#Else
  Private Declare Sub canInitializeLibrary Lib "CANLIB32.DLL" ()
  Private Declare Function canUnloadLibrary Lib "CANLIB32.DLL" () As Long
  Private Declare Function canGetNumberOfChannels Lib "CANLIB32.DLL" (ByRef channelCount As Long) As Long
  Private Declare Function canGetChannelData Lib "CANLIB32.DLL" (ByVal channel As Long, ByVal item As Long, ByRef buffer As Any, ByVal bufsize As Long) As Long
  Private Declare Function canOpenChannel Lib "CANLIB32.DLL" (ByVal handle As Long, ByVal Flags As Long) As Long
  Private Declare Function canClose Lib "CANLIB32.DLL" (ByVal handle As Long) As Long
  Private Declare Function canBusOn Lib "CANLIB32.DLL" (ByVal handle As Long) As Long
  Private Declare Function canBusOff Lib "CANLIB32.DLL" (ByVal handle As Long) As Long
  Private Declare Function canSetBusParams Lib "CANLIB32.DLL" (ByVal handle As Long, ByVal freq As Long, ByVal tseg1 As Long, ByVal tseg2 As Long, ByVal sjw As Long, ByVal noSamp As Long, ByVal syncMode As Long) As Long
  Private Declare Function canWrite Lib "CANLIB32.DLL" (ByVal handle As Long, ByVal id As Long, ByRef msg As Any, ByVal dlc As Long, ByVal flag As Long) As Long
  Private Declare Function canReadWait Lib "CANLIB32.DLL" (ByVal handle As Long, ByRef id As Long, ByRef msg As Any, ByRef dlc As Long, ByRef flag As Long, ByRef time As Long, ByRef timeout As Long) As Long
#End If
 
'Constant declarations
Private Const canOK = 0
Private Const canOPEN_ACCEPT_VIRTUAL = &H20
Private Const canBITRATE_250K = -3
Private Const canCHANNELDATA_CARD_SERIAL_NO = 7
 
 
'Declaration of CAN handles
#If VBA7 Then
  Private hnd0, hnd1 As LongPtr
#Else
  Private hnd0, hnd1 As Long
#End If

µ÷ÓÃ CANlib API

Sub CANLib_Start()
  Dim chCount, stat, i As Long
  Dim buffer As String
  Dim myArr(32) As Byte
  Dim ws As Worksheet
	
  canInitializeLibrary
  stat = canGetNumberOfChannels(chCount)
  If stat <> canOK Then GoTo ErrorHandler

Sheets.Add(Before:=Sheets(1)).name = "Device info" ' Add a sheet called "Device info" to the first position
 
Range("A1").Value = "Nof channels"
Range("B1").Value = chCount

For i = 0 To chCount - 1
  stat = canGetChannelData(i, canCHANNELDATA_CARD_SERIAL_NO, myArr(0), 32)
  buffer = StrConv(myArr(), vbUnicode)
  If buffer <> Empty Then
    Cells(i + 2, 1).Value = "Serial"
    Cells(i + 2, 2).Value = buffer
  End If
Next i

hnd0 = canOpenChannel(0, canOPEN_ACCEPT_VIRTUAL)
hnd1 = canOpenChannel(1, canOPEN_ACCEPT_VIRTUAL)
stat = canSetBusParams(hnd0, canBITRATE_250K, 0, 0, 0, 0, 0)
If stat <> canOK Then GoTo ErrorHandler
stat = canSetBusParams(hnd1, canBITRATE_250K, 0, 0, 0, 0, 0)
If stat <> canOK Then GoTo ErrorHandler
	
stat = canBusOn(hnd0)
If stat <> canOK Then GoTo ErrorHandler
stat = canBusOn(hnd1)
If stat <> canOK Then GoTo ErrorHandler

DeleteSheet ("Read data")
Set ws = Sheets.Add()
ws.name = "Read data"
ws.Cells(1, 1).Value = "ID"
ws.Cells(1, 2).Value = "Data1"
ws.Cells(1, 3).Value = "Data2"
ws.Cells(1, 4).Value = "Data3"
ws.Cells(1, 5).Value = "Data4"
ws.Cells(1, 6).Value = "Data5"
ws.Cells(1, 7).Value = "Data6"
ws.Cells(1, 8).Value = "Data7"
ws.Cells(1, 9).Value = "Data8"

Sub CANlib_Traffic()
  Dim tb As ListObject
  Dim iCol, iRow As Integer
  Dim sData(1 To 8), sCol As String
  Dim bDataTx(1 To 8) As Byte
  Dim bDataRx(1 To 8) As Byte
  Dim stat, lID, lDlc, lFlags, lTime As Long
	
	
  Worksheets("Imported ASC").Activate
  Set tb = ActiveSheet.ListObjects("TestLog")
 
  For iRow = 1 To tb.Range.Rows.Count
    lDlc = tb.DataBodyRange.Cells(iRow, tb.ListColumns("DLC").Index) ' Get how many data bytes
    For iCol = 1 To lDlc
      sCol = "Data" + Trim(Str(iCol)) 'Create the headline to read from
      sData(iCol) = tb.DataBodyRange.Cells(iRow, tb.ListColumns(sCol).Index)
      bDataTx(iCol) = CByte("&H" & sData(iCol)) ' Convert the Hex value to decimal
    Next iCol
    ' Send the byte stream of CAN data on the first channel   	
    stat = canWrite(hnd0, CLng(iRow), bDataTx(1), lDlc, 0)
    DoEvents
    ' Read out the received data on the second channel
    stat = canReadWait(hnd1, lID, bDataRx(1), lDlc, lFlags, lTime, 50)
    If stat = canOK Then
      With Worksheets("Read data") ' Populate cells in Excel with read CAN data
        .Cells(lID + 1, 1).Value = lID
        ' .Cells(lID + 1, 2).Value = CStr(Hex(bDataRx(1))) ' Use this if value should be in hexadecimal
        .Cells(lID + 1, 2).Value = bDataRx(1)
        .Cells(lID + 1, 3).Value = bDataRx(2)
        .Cells(lID + 1, 4).Value = bDataRx(3)
        .Cells(lID + 1, 5).Value = bDataRx(4)
        .Cells(lID + 1, 6).Value = bDataRx(5)
        .Cells(lID + 1, 7).Value = bDataRx(6)
        .Cells(lID + 1, 8).Value = bDataRx(7)
        .Cells(lID + 1, 9).Value = bDataRx(8)
      End With
    End If
  Next iRow
	
  MsgBox "Traffic done!"
End Sub

Sub CANLib_Stop()
  canBusOff (hnd0)
  canBusOff (hnd1)
  canUnloadLibrary
  MsgBox "CANlib is unloaded!"
End Sub

½á¹û

32λÓë64λMicrosoft Office

Private Const MAX_UINT32 = 4294967296#
Private Const MAX_INT32 = 2147483647
Function LongToUnsigned(ByVal Value As Long) As Double
  If Value < 0 Then
    LongToUnsigned = Value + MAX_UINT32
  Else
    LongToUnsigned = Value
  End If
End Function
 
Function UnsignedToLong(ByVal Value As Double) As Long
  If Value < 0 Or Value >= MAX_UINT32 Then Error 6
  If Value <= MAX_INT32 Then
    UnsignedToLong = Value
  Else
    UnsignedToLong = Value - MAX_UINT32
  End If
End Function

¶àÈÎÎñ´¦Àí

×ܽá