Copy, Modify, Paste, Send to CNC machine

[camle]

I have come up with an excel sheet to program a CNC machine at work. It reads a database (Main Data Mag Cyl) for different prints.
My question is: I need a VB code to copy A7:C616 and copy it to sheet name Edit - Send with (tabs and empty spaces) removed. From here I would like to send it to the com port to the CNC machine, also a pop-up windows asking if the machine is ready.
Hope you don't mind helping. Thanks

 

[camle]

Try this for starters. It uses VBA file I/O to send data to the COM2 port (no need for the MSComm control). You might have to change the string sent to the COM port - currently each value is separated by a space and terminated by CR LF characters.

Sub Send_to_COM_Port()

    Dim dataArray As Variant, r As Integer, c As Integer
    Dim SendSheet As Worksheet
    Dim lastRow As Long, row As Long
    Dim COMport As Integer
    Dim rowCells As Range
    Dim buffer As String
    
    Set SendSheet = Sheets("Edit - Send")
        
    'Copy A7:C616 to SendSheet, removing tabs and spaces
    
    dataArray = Sheets("Sheet1").Range("A7:C616")
    For r = 1 To UBound(dataArray, 1)
        For c = 1 To UBound(dataArray, 2)
            dataArray(r, c) = Replace(Replace(dataArray(r, c), vbTab, ""), " ", "")
        Next
    Next
    With SendSheet
        .Cells.Clear
        .Range("A1").Resize(UBound(dataArray, 1), UBound(dataArray, 2)).Value = dataArray
        lastRow = UBound(dataArray, 1)
    End With
    
    If MsgBox("Is the machine ready?", vbYesNo) = vbNo Then Exit Sub
    
    COMport = FreeFile
    Close #COMport
    
    'Open COM2 port with baud rate 2400, No parity, 8 data bits, and 1 stop bit
    
    Open "COM2:2400,N,8,1" For Random As #COMport
    
    'Send each row to COM2 port
    
    For row = 1 To lastRow
        
        'Create string with this row's A, B and C cell values separated by a space
        
        Set rowCells = SendSheet.Cells(row, 1).Resize(1, 3)
        buffer = Join(Application.Transpose(Application.Transpose(rowCells.Value)), " ")
        
        'Send string to COM2 port
        
        Put #COMport, , buffer & vbCrLf
        
        Application.Wait DateAdd("s", 0.2, Now)  'pause between each data send
        DoEvents
    Next
    
    Close #COMport
    
End Sub

Everything is working good from the help received.

Now, can you.... while sending to the port, can it be listing in a window to show progress?
I've some examples of sending it to a form with a listbox, but I can't get it to work right.


Cam

 

[John_w]

If you post your code for showing the progress in a listbox on a userform then maybe we can get it working.

 

[camle]

If you post your code for showing the progress in a listbox on a userform then maybe we can get it working.

Here is my macro to grab the data, put it in the send edit - send sheet, and also send the program


Sub Send_to_COM_Port()

Dim dataArray As Variant, r As Integer, c As Integer
Dim SendSheet As Worksheet
Dim lastRow As Long, row As Long
Dim COMport As Integer
Dim rowCells As Range

Dim intPortID As Integer 'Ex. 1, 2, 3, 4 for COM1 - COM4
Dim strBaudRate As String 'Baud Rate
Dim intStopBits As Integer 'Stop Bits
Dim intDataBits As Integer 'Data Bits
Dim strParity As String 'Parity
Dim strMachine As String 'Machine - Fadal, Bosto or Mori Seiki

Dim lngStatus As Long
Dim strData As String
Dim strDataSent As String

Set SendSheet = Sheets("Edit - Send")

strMachine = SendSheet.Cells(1, 13).Value 'can change this to whatever field needs to have the machine type. In this case "M1"

Select Case strMachine
Case "Fadal"
intPortID = 1
strBaudRate = "38400"
intStopBits = 1
intDataBits = 7
strParity = "E"

Case "Bosto"
intPortID = 1
strBaudRate = "19200"
intStopBits = 2
intDataBits = 7
strParity = "E"

Case "Mori Seiki"
intPortID = 1
strBaudRate = "4800"
intStopBits = 2
intDataBits = 7
strParity = "E"
Case Else
MsgBox ("No machine information available")
Exit Sub
End Select



'close the port if it is open
Call CommClose(intPortID)


'Copy cells to SendSheet, removing tabs and spaces

dataArray = Sheets("Edit - Send").Range("A1:A1000")
'For r = 1 To UBound(dataArray, 1)
'For c = 1 To UBound(dataArray, 2)
'dataArray(r, c) = Replace(Replace(dataArray(r, c), vbTab, ""), " ", "")
'Next
'Next
With SendSheet
.Cells.Clear
.Range("A1").Resize(UBound(dataArray, 1), UBound(dataArray, 2)).Value = dataArray

'Delete blank rows

lastRow = .UsedRange.row + .UsedRange.Rows.Count - 1
For row = lastRow To 1 Step -1
If WorksheetFunction.CountA(.Rows(row)) = 0 Then
.Rows(row).EntireRow.Delete
End If
Next

lastRow = .UsedRange.Rows.Count
End With

If MsgBox("Is the machine ready?", vbYesNo) = vbNo Then Exit Sub

Transmitting.Show



' Open COM port

lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
"baud=" & strBaudRate & " parity=" & strParity & " data=" & intDataBits & " stop=" & intStopBits)

'loop through all the rows of information and write the information


For row = 1 To lastRow

'Create string with the current cell value

strData = SendSheet.Cells(row, 1).Value & vbCrLf


'write to the COM port

lngStatus = CommWrite(intPortID, strData)
strDataSent = strDataSent & strData
'pause between each data send


Application.Wait DateAdd("s", 0.2, Now)

lstitems.Items.Add (strData)


'function surrenders execution of the macro so that the operating system can process other events. The DoEvents function passes control from the application to the operating system

DoEvents


Next

Call CommClose(intPortID)

MsgBox ("The following information was sent to the " & strMachine & ":" & vbCrLf & strDataSent)


End Sub



In the "lstitems.Items.Add (strData)" line it locks up.

I was try to stay in the loop so as it sent to the port, it would list to the listbox.

Hope this helps you understand what I'm trying to do.

If you need, is there a way to send you the excel file?
But I don't want to be too much trouble.

Thanks,
Cam

 

[John_w]

Please put code inside CODE tags.

In the "lstitems.Items.Add (strData)" line it locks up.

Try changing:

       Transmitting.Show

to:

       Transmitting.Show vbModeless

and

          lstitems.Items.Add (strData)

to:

        With Transmitting.lstitems
            .AddItem strData
            .TopIndex = .ListCount      'scroll to last item
        End With

 

[camle]

Please put code inside CODE tags.



Try changing:

       Transmitting.Show

to:

       Transmitting.Show vbModeless

and

          lstitems.Items.Add (strData)

to:

        With Transmitting.lstitems
            .AddItem strData
            .TopIndex = .ListCount      'scroll to last item
        End With

I'm getting a "method or data member not found" in the Transmitting.lstitems line.
Do i have to define it in someway?

 

[John_w]

The lstitems object is unchanged from your code. What is the name of the ListBox on the UserForm named Transmitting? The code expects it to be named lstitems.

 

[camle]

The lstitems object is unchanged from your code. What is the name of the ListBox on the UserForm named Transmitting? The code expects it to be named lstitems.

Helllloooo, i'm awake now.
that was it and it works great!!
Thank You very much

Cam

 

[camle]

The lstitems object is unchanged from your code. What is the name of the ListBox on the UserForm named Transmitting? The code expects it to be named lstitems.

Is there a way to remove the Carriage returns and the end of end line?

This is a huge project that I am working on. So do you mind if I hit you for info now and then?

Thanks,
Cam