Data direkte ind i Excel via RS232/USB fra Vægt

Can we see the code (VBA) you use in Access?

Another idea would be to expert the date from Access into Excel

expert = export ;-)

Access databasen kan en masse mere. Og kan ikke lige finde ud af hvordan jeg bare tager det og får det til at virke i Excel. Vil bare have aktuel data i A1 og næste i A2 osv.

Option Compare Database  'Use database order for string comparisons

Const BUILDCOMMDCB_PARMS = "COM1: baud=2400 parity=E data=7 stop=1"  '"COM1:2400,E,7,1"

Global Const MB_OK = 0, MB_OKCANCEL = 1    ' Define buttons.
Global Const MB_YESNOCANCEL = 3, MB_YESNO = 4
Global Const MB_ICONSTOP = 16, MB_ICONQUESTION = 32  ' Define icons.
Global Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
Global Const ID_OK = 1, ID_CANCEL = 2, ID_YES = 6, ID_NO = 7  ' Define other.

'Global system_id_g As Long, system_navn_g As String, operatør_g As String
'Global udstyr_type_g As Long, set_id_g As Long, procedure_akt_id_g As Long
Dim Samples(80) As Integer
'Dim tne_f As Integer

Function antal_emner_mod(F As Form)
On Error GoTo Err_antal_emner_mod
    'Dim db As DATABASE, qd As QueryDef
    Dim qd As QueryDef
    Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
    Dim system_id As Long, antal As Long, måling As Double
    Dim antalf As Integer
    Dim DocName As String
    Dim debug_txt As String
    Dim LinkCriteria As String
    'Set db = DBEngine.Workspaces(0).Databases(0)
    'Set db = CurrentDb
   
    MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
    MsgBoxTitle = "antal_emner_mod"
   
    system_id = system_id_g

    'test_id_g = DLast("[test_id]", "test")
   
    'IF...
    stiknr_prm = 1
    emnerpert_prm = 200
   
    'logic_switch = DLookup("[bestemt]", "test_type", "[test_type_id] = " & test_type_id_g)
    logic_switch = False
    If logic_switch Then
        antal = DLookup("[antal_emner]", "test_type", "[test_type_id] = " & test_type_id_g)
    Else
        'X = DCount("[Shipped Date]", "Orders", "[Ship Country] = '" & SearchCountry & "'And [Shipped Date] < #6-6-91#")
        antal = DLookup("[størrelse]", "godkendelse", "[partistørrelse_start] <= Form.total And [partistørrelse_start] >= Form.total")
        If IsNull(antal) Then
            MsgBox "max partistørrelse_stop værdi skal opdatteres i godkendelse tabel", 48, "Godkendelse"
            'Me!aktuel_pakkelinie_stikprøvestørrelse = 0
            Exit Function
        End If
        stik_prøve_value = antal
    End If
    antal_emner = antal

    debug_txt = CStr(antal)
    'ShowEvent (debug_txt)

   
End_antal_emner_mod:
    Exit Function

Err_antal_emner_mod:
    DoCmd.Hourglass False
    MsgBox Error$
    Resume End_antal_emner_mod

End Function

Function chk_computer_vægt() As Boolean
On Error GoTo Err_chk_computer_vægt
    Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
    Dim DocName As String
    Dim debug_txt As String
    Dim LinkCriteria As String

    MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
    MsgBoxTitle = "checke !"
 
Forfra_chk_computer_vægt:
   
    result = get_dialog("COM1", "ID")
    If (InStr(result, "STANDARD") <= 0) Then
        St% = MsgBox("Check forbindelsen mellem computer og vægt, og tryk derefter OK !", MsgBoxType, MsgBoxTitle)
        If St% = ID_OK Then
            GoTo Forfra_chk_computer_vægt
        Else
            chk_result = "back in business !"
            GoTo End_chk_computer_vægt
        End If
    End If
    chk_computer_vægt = True
   
End_chk_computer_vægt:
    Exit Function

Err_chk_computer_vægt:
    DoCmd.Hourglass False
    MsgBox Error$
    Resume End_chk_computer_vægt

End Function

Function clone_recordset(F As Form)

    'Dim db As DATABASE
    'Dim qd As QueryDef
    Dim ds As Recordset
    Dim HF As Form, rs As Recordset
    Set HF = Forms!måling_m
   
    HFSubMoveLast HF!Sub.Form, 0, result
    F!resultat = result
    F!måling = måling

End Function

Function CNB(v)
    If IsNull(v) Or IsEmpty(v) Then
        CNB = ""
    Else
        CNB = v
    End If

End Function

Function CNZ(v)
    If IsNull(v) Or IsEmpty(v) Then
        CNZ = 0
    Else
        CNZ = v
    End If

End Function

Sub EchoHour(flag As Integer)
    DoCmd.Hourglass flag
    Application.Echo (Not flag)
End Sub

Function get_current_record(F As Form)
'Dim MyWorkspace As Workspace, MyDB As DATABASE, MySet As Recordset
Dim MySet As Recordset
Dim MyMark As String
Dim total As Long
Dim flag As Integer

'Set MyWorkspace = DBEngine.Workspaces(0)
'Set MyDB = MyWorkspace.Databases(0)
'Set MySet = MyDB.OpenRecordset("select * from procedure_test_type_kryds_ref") 'Create dynaset
Set MySet = db.OpenRecordset("select * from procedure_test_type_kryds_ref") 'Create dynaset
'MySet.MoveNext

total = MySet.RecordCount
F!rækkefølge = total

End Function

ublic Function Kalibrere(CommPort As String, cmd As String) As String
On Error GoTo Error_Kalibrere
  Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
  Dim OpenPort As Integer, Timeout1, Timeout2
  Dim count_read As Integer
  Dim CR As String: CR = Chr$(13)
  Dim LF As String: LF = Chr$(10)
  Dim Instring As String * 96, InstringA As String
  Dim OutString As String
  Dim Status As Integer, StatusErr As Integer
  Dim BytesWritten As Long, BytesRead As Long
  Dim DCB1 As DCB, OFS As OFSTRUCT
  Dim Overlap As OVERLAPPED, TimeOuts As COMMTIMEOUTS
  Dim StartTimer As Double, UsedTime As Single

  OpenPort = OpenFile(CommPort, OFS, OF_READWRITE)
  'MsgBox "Open: " & OpenPort
  Status = GetLastError()
  If OpenPort <= 0 Or Status <> 0 Then
    Msg = "Kan ikke åbne COM port " & CommPort & ". Fejlkode = " & Status
    GoTo Err_Kalibrere
  End If
   
  'Sæt COMM port parametre
  Status = GetCommState(OpenPort, DCB1)
  If Status = 0 Then StatusErr = 1: GoTo Status1_Kalibrere
  Status = BuildCommDCB(BUILDCOMMDCB_PARMS, DCB1)
  If Status = 0 Then StatusErr = 2: GoTo Status1_Kalibrere
  Status = SetCommState(OpenPort, DCB1)
  If Status = 0 Then StatusErr = 3: GoTo Status1_Kalibrere
Status1_Kalibrere:
  Status = GetLastError()
  If Status <> 0 Or StatusErr <> 0 Then
    Msg = "BuildDCB. Fejlkode =  " & StatusErr & "-" & Status
    GoTo Err_Kalibrere
  End If
   
  St% = SystemParameter("Timeout", Timeout1, Timeout2)
  TimeOuts.ReadIntervalTimeout = CInt(Timeout1)  'msecs
  TimeOuts.ReadTotalTimeoutMultiplier = 0  'msecs
  TimeOuts.ReadTotalTimeoutConstant = CInt(Timeout2 * 30) 'msecs
  Status = SetCommTimeouts(OpenPort, TimeOuts)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sætte timeouts. Fejlkode = " & Status
      GoTo Err_Kalibrere
    End If
  End If

  '************************************* 7-5-02
  'Send kommando til vægten - init
  OutString = CR + LF
  Overlap.hEvent = 0&
  Status = WriteFile(OpenPort, ByVal OutString, Len(OutString), BytesWritten, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sende kommando " & OutString & ". Fejlkode = " & Status
      GoTo Err_Kalibrere
    End If
  End If
  Status = ReadFile(OpenPort, ByVal Instring, Len(Instring), BytesRead, Overlap)
  If Status = 0 Then
      Status = GetLastError()
      If Status <> 0 Then
          MsgBox "No input read from " & OpenPort & ". Fejlkode = " & Status
          GoTo Err_Kalibrere
      End If
  End If
  '************************************* 7-5-02

  'Send kommando til vægten
  OutString = cmd + CR + LF
  Overlap.hEvent = 0&
  'MsgBox "Klar til at sende"
  Status = WriteFile(OpenPort, ByVal OutString, Len(OutString), BytesWritten, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sende kommando " & OutString & ". Fejlkode = " & Status
      GoTo Err_Kalibrere
    End If
  Else
    'MsgBox "Har sendt " & BytesWritten & " karakterer: " & OutString
  End If
   
  'Aflæs port for stabil kalibrering
  DoCmd.Hourglass True
  count_read = 0
  StartTimer = Timer
  Do
    Status = ReadFile(OpenPort, ByVal Instring, Len(Instring), BytesRead, Overlap)
    If Status = 0 Then
        Status = GetLastError()
        If Status <> 0 Then
            MsgBox "No input read from " & OpenPort & ". Fejlkode = " & Status
            GoTo Err_Kalibrere
        End If
    Else
        InstringA = Left$(Instring, BytesRead)
        result_kalibrering = Right$(InstringA, BytesRead)
        'Debug.Print BytesRead & " " & InstringA
        'Debug.Print result_kalibrering
    End If
    'MsgBox "Har læst " & BytesRead & " karakterer: " InstringA
    DoCmd.Hourglass False
    Kalibrere = InstringA
    'Debug.Print result_kalibrering
    Debug.Print Kalibrere
    count_read = count_read + 1
    If (InStr(Kalibrere, "CB 1") > 0 Or InStr(Kalibrere, "CB 0") > 0) Then
        count_read = 10
    End If
    UsedTime = Timer - StartTimer
Loop Until count_read >= 4 Or UsedTime > 60

If (InStr(Kalibrere, "CB 1") > 0) Then
    calibration_OK = True
Else
    calibration_OK = False
End If

  ' Luk kommunikationsport
Close_Kalibrere:
  On Error Resume Next
  'MsgBox "Klar til at lukke"
  Status = CloseHandle(OpenPort)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke lukke COM port " & CommPort & ". Fejlkode = " & Status
      MsgBox Msg, MB_ICONSTOP, "Close"
    End If
  End If
  'MsgBox "Har lukket"
  Exit Function

Err_Kalibrere:      'Dette er ikke en On Error rutine
  Msg = Msg & CR & CR & "Undersøg om andre programmer/enheder benytter " & CommPort
  MsgBoxType = MB_ICONSTOP
  MsgBoxTitle = "Fejl"
  MsgBox Msg, MsgBoxType, MsgBoxTitle
  GoTo Close_Kalibrere

Error_Kalibrere:
  MsgBox Error$
  Resume Close_Kalibrere

End Function
Function Måling_kørsel(F As Form) As Boolean
On Error GoTo Err_Måling_kørsel
    Dim qd As QueryDef
    Dim Msg As String
    Dim MsgBoxType As Integer
    Dim MsgBoxTitle As String
    Dim system_id As Long
    Dim antal As Long
    Dim måling As Double
    Dim vægt_tolerance As Double
    Dim min_måling As Double
    Dim antalf As Integer
    Dim count_mangler As Integer
    Dim DocName As String
    Dim debug_txt As String
    Dim LinkCriteria As String
    Dim måling_flag As String
    Dim overvægtig As Double
    Dim StartTimer As Double
    Dim UsedTime As Single
    Dim exit_flag As Boolean
   
    repeat_allowed% = DLookup("tillad_manuel_test", "inspektør", "bruger='" & CurrentUser() & "'")
    exit_flag = False
    min_måling = DMin("[negativ_tolerance_Qn_start]", "negativ_tolerance")
    overvægtig = DMax("[negativ_tolerance_Qn_stop]", "negativ_tolerance")
    null_loop_g = NullToZero(DLookup("[Parameter1]", "SystemParameters", "ID = 'null_loop'"))
    vejning_loop_g = NullToZero(DLookup("[Parameter1]", "SystemParameters", "ID = 'vejning_loop'"))
    vægt_tolerance = DLookup("[Parameter1]", "vægt_tolerance_null", "[id] = 'tolerance'")
   
    Dim ds As Recordset
    Dim HF As Form, rs As Recordset
    Set HF = Forms!måling_m
    Set ds = HF!Sub.Form.RecordsetClone
   
    MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
    MsgBoxTitle = "Måling"
 
    'count_mangler = 0
   
    Måling_kørsel = False
    system_id = system_id_g
    logic_switch = DLookup("[bestemt]", "test_type", "[test_type_id] = " & test_type_id_g)
    If logic_switch Then
        antal = DLookup("[antal_emner]", "test_type", "[test_type_id] = " & test_type_id_g)
    Else
        'antal = DLookup("[størrelse]", "godkendelse", "[partistørrelse_stop] >= " & stik_value)
        antal = stik_pr_antal_emner
        stik_prøve_value = antal
    End If
    antal_emner = antal
    If (destruktiv_måling_g And test_type_id_g >= 3) Then
        'antal = 20
        stik_prøve_value = antal
        antal_emner = antal
    End If
    antal_emner_mark_random = antal
    If test_type_id_g = 3 Then
        antal = DLookup("[antal_individuel_emballage]", "individuel_emballage_størrelse", "[stikprøve_størrelse] = " & antal)
        stik_prøve_value = antal
    End If
   
    F!emner = stik_prøve_value
    manuel = manuel_kørsel_g
    forfra_test = False

    If test_type_id_g = 3 Then
        individuel_mark = True
    Else
        individuel_mark = False
    End If
   
Forfra_Måling_kørsel:
   
    F!emne_id = Null
    F!resultat = Null
    test_id_g = DMax("[test_id]", "test")
    F!test_id.Requery
    F!Sub.Form.Requery
    emne_resultat_id_first = 0
 
    Set qd = db.QueryDefs("resultatAQ")
    vægt_på_null = True
    i% = 0
    emne_resultat_id_first = 0
   
'--------------------------------------------------------------------------------------------------------------
    Do
        i% = NullToZero(DCount("[emne_id]", "emne_resultat", "test_id = " & test_id_g & " And kasseret = False"))
        i% = i% + 1
        'Bed brugeren sætte emnet på vægten
START_Måling_kørsel:
        count_mangler = NullToZero(DCount("[emne_resultat_id]", "emne_resultat", "test_id = " & test_id_g & " And manglende = True"))
        If count_mangler > 5 Then
            St% = MsgBox("Sidste sæt emner gentages.", MB_ICONINFORMATION, MsgBoxTitle)
            Set qd = db.QueryDefs("emne_resultat_annullUQ")
            qd.Parameters("test_id_p") = test_id_g
            qd.Execute
            qd.Close
            forfra_test = True
            F!OK.Caption = "Forfra Måling kørsel"
            Exit Do
        End If
        If (last_test_type_id_g = 3 Or del2_g Or del1_g) And emne_omfatter_g <> 1 And destruktiv_måling_g = 0 Then
            If last_test_type_id_g = 3 Then
                j% = i%
                antal_print = antal
            End If
            If del1_g Then
                j% = i% * 2 - 1
                antal_print = antal * 2 - 1
            End If
            If del2_g Then
                j% = i% * 2
                antal_print = antal * 2
            End If
        Else
            j% = i%
            antal_print = antal
        End If
        If procedure_id_g = 35 Then
            j% = i%
            antal_print = antal
        End If
        Msg = "Stil emne " & j% & " (af " & antal_print + count_mangler * 2 & ") på vægten."
AUTOMAT:
        If manuel = False Then
            If Not chk_computer_vægt() Then
                forfra_test = True
                St% = MsgBox("Sidste sæt emner gentages.", MB_ICONINFORMATION, MsgBoxTitle)
                Exit Do
            End If
            If i% <> 1 Then
                count_timer = 1
                vægt_på_null = False
                Do While count_timer <= null_loop_g
                    result = get_dialog("COM1", "S")
                    If Not (IsNull(result) Or result = "" Or IsEmpty(result)) Then
                        If (Left(result, 1) = "S") And InStr(result, "g") > 0 Then
                            målingRes$ = Left(result, Len(result) - 2)
                            måling = Val(Mid(målingRes$, 4, 9))
                        Else
                            måling = vægt_tolerance + 1
                        End If
                        If måling <= vægt_tolerance Then
                            vægt_på_null = True
                            Exit Do
                        End If
                    End If
                    count_timer = count_timer + 1
                Loop
                If vægt_på_null = False Then
                    St% = MsgBox("Husk at fjerne sidste emne fra vægten.", vbCritical, MsgBoxTitle)
                    GoTo START_Måling_kørsel
                End If
            End If
            RC = MsgBox(Msg, MsgBoxType, MsgBoxTitle)
            count_timer = 0
            Do
                result = get_dialog("COM1", "S")
                If (Left(result, 1) = "S") And InStr(result, "g") > 0 Then
                    målingRes$ = Left(result, Len(result) - 2)
                    måling = Val(Mid(målingRes$, 4, 9))
                Else
                    måling = 0
                End If
                count_timer = count_timer + 1
            Loop Until count_timer >= vejning_loop_g Or måling <> 0
            If IsNull(måling) Or result = "" Or IsNumeric(måling) = 0 Or Val(måling * 100) = 0 Then
                result = ""
            End If
'===> *4?
        Else
MANUAL:
            If repeat% = 0 Then
                result = InputBox(Msg & Chr(13) & Chr(10) & "Indtast måleresultat i gram.", MsgBoxTitle)
                If repeat_allowed% Then
                    ix% = InStr(result, "*")
                    If ix% > 0 Then
                        repeat% = Val(Mid$(result, ix% + 1))
                        result = Left$(result, ix% - 1)
                        repeat_value$ = result
                    End If
                End If
            Else
                result = repeat_value$
            End If
            If repeat% > 0 Then repeat% = repeat% - 1
            If IsNumeric(result) = False Then
                result = ""
            Else
                If IsNull(result) Or result = "" Or CDbl(result) = 0 Then result = ""
            End If
            'If IsNull(result) Or result = "" Or IsNumeric(result) = False Or CDbl(result) = 0 Then
            '    result = ""
            'End If
'===> *4?
        End If

        måling = 0
        If Not result = "" Then
            DoCmd.Hourglass True
            qd.Parameters("system_id_p") = system_id_g
            qd.Parameters("emne_id_p") = j%
            qd.Parameters("test_id_p") = test_id_g
            If manuel = False Then
                qd.Parameters("emne_resultat_p") = Left(result, Len(result) - 2)
                If (Left(result, 1) = "S") And InStr(result, "g") > 0 Then
                    målingRes$ = Left(result, Len(result) - 2)
                    måling = Val(Mid(målingRes$, 4, 9))
                Else
                    måling = vægt_tolerance - 1
                End If
            Else
                qd.Parameters("emne_resultat_p") = result
                måling = CDbl(result)
            End If
            qd.Parameters("emneomfatter") = emne_omfatter_g
            qd.Parameters("aktuelprocedureid") = aktuel_procedure_id_g
            qd.Parameters("del1") = del1_g
            qd.Parameters("del2") = del2_g
            qd.Parameters("godkendelse") = True
            qd.Parameters("identitet") = identitet_emne_g
           
            If måling >= min_måling And måling <= overvægtig Then
                qd.Parameters("emne_måling_p") = måling
                qd.Execute

                DoCmd.Beep
                HFSubMoveLast HF!Sub.Form, j%, result
               
                emne_resultat_id_g = DMax("[emne_resultat_id]", "emne_resultat")
                If emne_resultat_id_first = 0 Then
                    emne_resultat_id_first = emne_resultat_id_g
                End If
                DoCmd.Hourglass False
                'DoCmd.Beep
            End If
        End If
Public Function get_dialog(CommPort As String, cmd As String) As String
On Error GoTo Error_get_dialog
  Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
  Dim OpenPort As Integer, Timeout1, Timeout2
  Dim CR As String: CR = Chr$(13)
  Dim LF As String: LF = Chr$(10)
  Dim Instring As String * 96, InstringA As String
  Dim OutString As String
  Dim Status As Integer, StatusErr As Integer
  Dim BytesWritten As Long, BytesRead As Long
  Dim DCB1 As DCB, OFS As OFSTRUCT
  Dim Overlap As OVERLAPPED, TimeOuts As COMMTIMEOUTS

  OpenPort = OpenFile(CommPort, OFS, OF_READWRITE)
  'MsgBox "Open: " & OpenPort
  Status = GetLastError()
  If OpenPort <= 0 Or Status <> 0 Then
    Msg = "Kan ikke åbne COM port " & CommPort & ". Fejlkode = " & Status
    GoTo Err_get_dialog
  End If
   
  'Sæt COMM port parametre
  Status = GetCommState(OpenPort, DCB1)
  If Status = 0 Then StatusErr = 1: GoTo Status1_get_dialog
  Status = BuildCommDCB(BUILDCOMMDCB_PARMS, DCB1)
  If Status = 0 Then StatusErr = 2: GoTo Status1_get_dialog
  Status = SetCommState(OpenPort, DCB1)
  If Status = 0 Then StatusErr = 3: GoTo Status1_get_dialog
Status1_get_dialog:
  Status = GetLastError()
  If Status <> 0 Or StatusErr <> 0 Then
    Msg = "BuildDCB. Fejlkode =  " & StatusErr & "-" & Status
    GoTo Err_get_dialog
  End If
   
  St% = SystemParameter("Timeout", Timeout1, Timeout2)
  TimeOuts.ReadIntervalTimeout = CInt(Timeout1)  'msecs
  TimeOuts.ReadTotalTimeoutMultiplier = 0  'msecs
  TimeOuts.ReadTotalTimeoutConstant = CInt(Timeout2)  'msecs
  Status = SetCommTimeouts(OpenPort, TimeOuts)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sætte timeouts. Fejlkode = " & Status
      GoTo Err_get_dialog
    End If
  End If

  '************************************* 7-5-02
  'Send kommando til vægten - init
  OutString = CR + LF
  Overlap.hEvent = 0&
  Status = WriteFile(OpenPort, ByVal OutString, Len(OutString), BytesWritten, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sende kommando " & OutString & ". Fejlkode = " & Status
      GoTo Err_get_dialog
    End If
  End If
  Status = ReadFile(OpenPort, ByVal Instring, Len(Instring), BytesRead, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      MsgBox "No input read from " & OpenPort & ". Fejlkode = " & Status
      GoTo Err_get_dialog
    End If
  End If
  '************************************* 7-5-02

  'Send kommando til vægten
  OutString = cmd + CR + LF
  Overlap.hEvent = 0&
  'MsgBox "Klar til at sende"
  Status = WriteFile(OpenPort, ByVal OutString, Len(OutString), BytesWritten, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke sende kommando " & OutString & ". Fejlkode = " & Status
      GoTo Err_get_dialog
    End If
  Else
    'MsgBox "Har sendt " & BytesWritten & " karakterer: " & OutString
  End If
   
  'Aflæs port for stabil vejning
  DoCmd.Hourglass True
  Status = ReadFile(OpenPort, ByVal Instring, Len(Instring), BytesRead, Overlap)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      MsgBox "No input read from " & OpenPort & ". Fejlkode = " & Status
      GoTo Err_get_dialog
    End If
  Else
    InstringA = Left$(Instring, BytesRead)
    result_kalibrering = Right$(InstringA, BytesRead)
    'Debug.Print BytesRead & " " & InstringA
    Debug.Print result_kalibrering
  End If
  'MsgBox "Har læst " & BytesRead & " karakterer: " InstringA
  DoCmd.Hourglass False
  get_dialog = InstringA

  ' Luk kommunikationsport
Close_get_dialog:
  On Error Resume Next
  'MsgBox "Klar til at lukke"
  Status = CloseHandle(OpenPort)
  If Status = 0 Then
    Status = GetLastError()
    If Status <> 0 Then
      Msg = "Kan ikke lukke COM port " & CommPort & ". Fejlkode = " & Status
      MsgBox Msg, MB_ICONSTOP, "Close"
    End If
  End If
  'MsgBox "Har lukket"
  Exit Function

Err_get_dialog:      'Dette er ikke en On Error rutine
  Msg = Msg & CR & CR & "Undersøg om andre programmer/enheder benytter " & CommPort
  MsgBoxType = MB_ICONSTOP
  MsgBoxTitle = "Fejl"
  MsgBox Msg, MsgBoxType, MsgBoxTitle
  GoTo Close_get_dialog

Error_get_dialog:
  MsgBox Error$
  Resume Close_get_dialog
End Function

Private Function start_null_loop_procedure()

End Function

Function get_unit()
On Error GoTo get_unit
    Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
    Dim DocName As String
   
    MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
    MsgBoxTitle = "Kalibrering"
   
 

Forfra_get_unit:

'RC = MsgBox("get unit status", MB_ICONINFORMATION, MsgBoxTitle)
            result = get_dialog("COM1", "U g")
            'result = get_dialog("COM1", "U Kg")
            'If (result = "Err 1") Then
            '    GoTo Forfra_get_unit
            'End If

End_get_unit:
    Exit Function

get_unit:
    DoCmd.Hourglass False
    MsgBox Error$
    Resume End_get_unit

End Function

Function make_writing()
On Error GoTo make_writing
    Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
    Dim DocName As String
   
    MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
    MsgBoxTitle = "make_writing"
   
 

Forfra_make_writing:

'RC = MsgBox("get unit status", MB_ICONINFORMATION, MsgBoxTitle)
            result = get_dialog("COM1", "D " & display_text_g)
           
End_make_writing:
    Exit Function

make_writing:
    DoCmd.Hourglass False
    MsgBox Error$
    Resume End_make_writing

There are  a few errors in your copy paste, but I get the idea.

And there must also be a number of references otherwise code cant run as it is.

Lots of the code is specific for the code running in Access and I think it would take quite a bit of time to convert it to run in Excel.

I think the easiest solution is to add a bit of code to your Access solution which exports the data to Excel.

"Jeg ønsker at få aktuel vægtdata direkte ind i Excel"

Access can export data from a table into Excel, this could be done each time an item gets weighed in Access.

I assume you have the Balance Link PC software
https://www.mt.com/be/en/home/library/software-downloads/laboratory-weighing/BalanceLink_1.html

That should help you find out what is required to integrate into Excel

Hey. Jeg har ikke Balance Link PC software. Jeg ved godt at Access VBA koderne er med fejl. Det er fordi alt ikke er kopieret ind. Da det ikke er aktuelt. Da det er et kompleks database. Men stor bruger venlighed. Nu ønsker jeg bare at få et vejetal ind i celle A1 , A2 osv. i Excel.

I still think the easiest way to get the data into Excel is through Access, but its necessary to find where in the code you can do this.

You also need to decide if you will export all the data from the table the "vejetal" is inserted into, or just the last reading.

The best way to find out where is by debugging your way through the code.

Its possible to automate Excel from Access, have you experience with that?