Nom de l'utilisateur

declare function GetUsername Lib "advapi32.dll" Alias "GetUsernameA" (ByVal lpBuffer As String, nSize As long) As long
Sub showUsername()
msgbox Username
end Sub


function Username() As String
dim Buffer As String * 100
dim BuffLen As long
BuffLen = 100
GetUsername Buffer, BuffLen
Username = Left(Buffer, BuffLen - 1)
end function


ou tout simplement :
Sub UserData()
userdir = environ("userprofile") ' répertoire du user actuel
user= environ("username")        ' nom du user
msgbox userdir
msgbox user
end Sub

'Lecture des variables d'environnement : news
'Voir plus bas pour connaître le répertoire temporaire (temp folder)


Nom d'un utilisateur sur le réseau : news

Fichier utilisé par un autre utilisateur ?

function FileLocked(strFilename As String) As Boolean
On Error Resume next
' if the file is already opened by another process, and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFilename for Binary Access Read Lock Read As #1
Close #1
' if an error occurs, the document is currently open.
if Err.Number <> 0 then ' Display the error number and description.
msgbox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = true
Err.Clear
end if
end function

Autre méthode : page test d'existence

Qui a dernièrement modifié le fichier : msgbox BuiltindocumentProperties("Last Author").value
D'autres infos sur les propriétés d'un fichier : xl_fichier.htm

Informations sur le système & l'ordinateur

Nom du système

function OSis32BIT() As Boolean
OSis32BIT = false
if InStr(application.OperatingSystem, "32-bit") then OSis32BIT = true
end function

Sub TestOSis32BIT()
if OSis32BIT then
msgbox "You use a 32bit operating system", , application.OperatingSystem
Else
msgbox "You don't use a 32bit operating system", , application.OperatingSystem
end if
end Sub

Reconnaître le système d'exploitation : news

Nom de l'ordinateur

Private declare function GetComputername Lib "kernel32" _ Alias "GetComputernameA" (ByVal lpBuffer As String, nSize As long) As long

function ReturnComputername() As String
dim rString As String * 255, sLen As long, tString As String
tString = ""
On Error Resume next
sLen = GetComputername(rString, 255)
sLen = InStr(1, rString, Chr(0))
if sLen > 0 then
tString = Left(rString, sLen - 1)
Else
tString = rString
end if
On Error Goto 0
ReturnComputername = UCase(Trim(tString))
end function

IP de l'ordinateur

Private declare function apiGetComputername Lib "kernel32" Alias _
"GetComputernameA" (ByVal lpBuffer As String, nSize As long) As long

Sub Display_UserIP()
msgbox fOSMachinename
end Sub

function fOSMachinename() As String
dim lngLen As long
dim lngX As long
dim strCompname As String
lngLen = 16
strCompname = String$(lngLen, 0)
lngX = apiGetComputername(strCompname, lngLen)
if lngX <> 0 then
fOSMachinename = Left$(strCompname, lngLen)
Else
fOSMachinename = ""
end if
end function

Liste des PC disponibles sur un réseau : web
Voir aussi les actions sur le système effectuées à l'aide d'api windows : xl_ole.htm

Répertoire temporaire : msgbox Environ("Temp")
Connaître le répertoire temporaire et créer des fichiers temporaires avec des fonctions API Windows : news
Voir aussi d'autres méthodes dans la première partie de xl_fichier.htm

Répertoire des modèles Excel : msgbox Application.TemplatesPath
Répertoire par défaut de l'utilisateur en cours : application.DefaultFilePath
Répertoire par défaut alternatif de l'utilisateur en cours : AltStartupPath
Article Q108278 - XL Macros to Return Windows and System Directories .htm

Lister les disques locaux

De: Chip Pearson, sujet: "Re: Listing all the Local drives", le jeudi 28 décembre 2000 22:45

Dim FSO As Scripting.FileSystemObject
Dim OneDrive As Scripting.Drive
Set FSO = New Scripting.FileSystemObject
For Each OneDrive In FSO.Drives
If OneDrive.IsReady = True Then
Debug.Print OneDrive.DriveLetter
End If
Next OneDrive
'mettre une réference à Microsoft Scripting RunTime Library.

Paramètres de l'ordinateur

Consulter/Modifier la base de registres : xl_et_registre.htm
Virgule à la place du point sur le pavé numérique

Il faut aller dans le "Poste de travail", puis cliquer sur l'icône du "Panneau de configuration" et ensuite sur l'icône "Paramètres régionaux" et choisir l'onglet "Nombre". Dans le choix "Symbole décimal" il est possible de choisir le . (point) à la place de la , (virgule). Ceci va permettre d'utiliser le point du pavé numérique comme séparateur décimal dans toutes les applications Windows.

Taille des commentaires : xl_cellule.htm
Où changer le nom d'utilisateur et de société enregistres lors de l'installation d'un produit comme excel ou word Dans la base de registres.
Office 97 : HKEY_CURRENT_USER\Software\Microsoft\Office\8.0\Common\UserInfo\UserName HKEY_CURRENT_USER\Software\Microsoft\Office\8.0\Common\UserInfo\Company
Office 2000 : HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Common\UserInfo\UserName HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Common\UserInfo\Company

Informations sur votre souris !

Temps paramétré pour le double-clic

"Re: différencier les clics, double-clic clic bis", ou connaître le temps entre deux clics
De: Laurent longre, date : mardi 4 juillet 2000 14:27

Private Declare function GetdoubleClickTime Lib "User32" () As long
Sub Test()
MsgBox "Nombre maximal de millisecondes avant " & "le double-clic : " & GetdoubleClickTime
End Sub

Position de la souris !

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type


Function fncCurrentCursorPos() As POINTAPI
Call GetCursorPos(fncCurrentCursorPos)
End Function

Sub test()
Debug.Print fncCurrentCursorPos.x
Debug.Print fncCurrentCursorPos.y
End Sub

Positionner la souris

Article de Nix : Comment puis-je positionner la souris aux coordonnées que je souhaite sur mon écran ?

Declare function SetCursorPos Lib "user32" (ByVal x As long, ByVal y As long) As long

Puis utilisez ce code :

Dim Retour As long
Retour = SetCursorPos( 10, 10)

Personnaliser la fenêtre "A-Propos" du menu Aide

Option Explicit

Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" _
(ByVal hwnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

'// My thanks to "venky_dude"
'// Code modified for XP+ 26 may 2002 by Ivan F Moala
'// Errors in Type declaration on
'// platforms that don't support
'// wServicePackMajor As Integer 'NB some Platforms returns 0 and Not 1
'// wServicePackMinor As Integer 'NB some Platforms returns 0 and Not 1
'// wSuiteMask As Integer 'NB some Platforms returns 0 and Not 1
'// wProductType As Byte 'NB some Platforms returns 0 and Not 1
'// wReserved As Byte 'NB some Platforms returns 0 and Not 1
'// Testing done by MVP Members

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Dim Rm As Object

Sub About()
Dim hwnd As Long
Dim nl As String
Dim x As Long

nl = Chr$(10) + Chr$(13)
'// Some OS Error out with overflow
'// Typically NT - Resetting fixs it
'// With no adverse effects!
On Error Resume Next
hwnd = GetActiveWindow()
x = ShellAbout(hwnd, ThisWorkbook.Name, nl + Chr(169) + "[Left]" & _
" Full credit to Colo (Ivan), 12 May, 2002" + nl, 0)
On Error GoTo 0

End Sub

Sub Sys_Info()
Application.CommandBars.FindControl(ID:=927).Execute
End Sub