Petit programme sans prétention mais je pense utile. Conversion Twips - Inch - Cm - Himetric - Points et Degrés - Radians
Source / Exemple :
'Il faut 7 TextBox
' twips - inch Cm - Himetrix - Points - Degrés - radians
' Text(0) à Text(6)
' 3 Btns 1) Convertir - 2) Sortie - 3) Mise à zéro
Private Sub Command1_Click()
Dim x As Integer, y As Integer, Element, Pi
Dim iTwips, iPouce, iCm, iHimetric, iPoint, iDegre, iRadius
Pi = Atn(1) * 4
'
y = 0
For Each Element In Text()
If Element <> "" Then
y = y + 1
End If
Next
If y < 1 Then
MsgBox "Valeur non saisie", vbCritical
Exit Sub
End If
If y > 1 Then
MsgBox "Erreur plus d'une valeur", vbCritical
For x = 0 To 6
Text(x) = ""
Next x
Exit Sub
End If
If Text(0) <> "" Then
iTwips = Text(0)
iPouce = Text(0) / 1440
iCm = Text(0) / 567
iHimetric = Text(0) / 0.567
iPoint = (Text(0) / 1440) * 72
ElseIf Text(1) <> "" Then
iTwips = Text(1) * 1440
iPouce = Text(1)
iCm = Text(1) * 2.54
iHimetric = Text(1) * 2540
iPoint = Text(1) * 72
ElseIf Text(2) <> "" Then
iTwips = Text(2) * 567
iPouce = Text(2) / 2.54
iCm = Text(2)
iHimetric = Text(2) * 1000
iPoint = (Text(2) / 2.54) * 72
ElseIf Text(3) <> "" Then
iTwips = Text(3) * 0.567
iPouce = Text(3) / 2540
iCm = Text(3) / 1000
iHimetric = Text(3)
iPoint = (Text(3) / 2540) * 72
ElseIf Text(4) <> "" Then
iTwips = (Text(4) * 1440) / 72
iPouce = Text(4) / 72
iCm = (Text(4) / 72) * 2.54
iHimetric = (Text(4) / 72) * 2540
iPoint = Text(4)
End If
If Text(5) <> "" Then
iRadius = Text(5) * Pi / 180
iDegre = Text(5)
ElseIf Text(6) <> "" Then
iDegre = Text(6) / Pi * 180
iRadius = Text(6)
End If
Text(0) = FormatNumber(iTwips, 0)
Text(1) = FormatNumber(iPouce, 2)
Text(2) = FormatNumber(iCm, 2)
Text(3) = FormatNumber(iHimetric, 0)
Text(4) = FormatNumber(iPoint, 0)
Text(5) = FormatNumber(iDegre, 0)
Text(6) = FormatNumber(iRadius, 4)
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim Element, x As Integer
For x = 0 To 6
Text(x) = ""
Next x
End Sub
Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
Dim chrval
chrval = "0123456789."
Select Case KeyAscii
Case vbKeyReturn
SendKeys "{Tab}"
Case Else
If InStr(chrval, Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Select
End Sub
Conclusion :
Si il y a un bug, merci de m'en faire part.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.