Indicar en un label la IP desde donde se conecta el PC

Copia el siguiente código en un módulo (como verás el código original es de KL)

'propuesta de KL en :
'http://groups.google.com/group/microsoft.public.es.excel/browse_thread/thread/fbde1d16a4e3e9e8/6997f055f577378c?lnk=gst&q=ipaddress#6997f055f577378c
'
Private Const IP_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Long
    wMaxUDPDG As Long
    dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
                                    (ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (xDest As Any, xSource As Any, _
                                    ByVal nbytes As Long)
Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
                                    (ByVal wVersionRequired As Long, _
                                     lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function inet_addr Lib "WSOCK32.DLL" _
                                    (ByVal s As String) As Long
Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" (ByVal Buffer As String, _
                                    Size As Long) As Long
Sub TestingFunction()
    If SocketsInitialize() Then
        MsgBox GetIPFromHostName(GetPcName), , "IP address of " & GetPcName
    End If
    SocketsCleanup
End Sub
Private Function GetIPFromHostName(ByVal sHostName As String) As String
    'converts a host name to an IP address.
    Dim nbytes As Long
    Dim ptrHosent As Long        'address of hostent structure
    Dim ptrName As Long        'address of name pointer
    Dim ptrAddress As Long        'address of address pointer
    Dim ptrIPAddress As Long
    Dim sAddress As String
    sAddress = Space$(4)
    ptrHosent = gethostbyname(sHostName & vbNullChar)
    If ptrHosent <> 0 Then
        ptrName = ptrHosent
        ptrAddress = ptrHosent + 12
        'get the IP address
        CopyMemory ptrName, ByVal ptrName, 4
        CopyMemory ptrAddress, ByVal ptrAddress, 4
        CopyMemory ptrIPAddress, ByVal ptrAddress, 4
        CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
        GetIPFromHostName = IPToText(sAddress)
    End If
End Function
Private Function IPToText(ByVal IPAddress As String) As String
    IPToText = CStr(Asc(IPAddress)) & "." & _
               CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
               CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
               CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Private Sub SocketsCleanup()
    If WSACleanup() <> 0 Then
        MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
    End If
End Sub
Private Function SocketsInitialize() As Boolean
    Dim WSAD As WSADATA
    SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Private Function GetPcName() As String
    Dim strBuf As String * 16, strPcName As String, lngPc As Long
    lngPc = GetComputerName(strBuf, Len(strBuf))
    If lngPc <> 0 Then
        strPcName = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
        GetPcName = strPcName
    Else
        GetPcName = vbNullString
    End If
End Function

Y luego asignale a algún objeto la macro TestingFunction

Deberías modificar esa macro (que está dentro del código que te pasé) para que haga lo que necesitas...

Salu2

Muchas gracias.

Voy a probar y le cuento.

Saludos

Me da error con la versión de excel que estoy usando (2016)