Luca Lenzo
2018-06-25 14:48:55 UTC
Salve, buongiorno a tutti,
è da molto che non chiedevo un aiuto a voi che in passato avete risolto molti miei problemi.
questa volta volevo chiedere un favore, io devo convertire da pollici a inches dei valori per poi riconvertirli in millimetri.
Ora, io ho trovato un plug-in che fa ciò che mi serve, ma ho il problema di doverlo attivare ogni volta e se un mio collega apre lo stesso file si trova con degli errori...
Son riuscito quindi a leggere questo codice qua nel Plug-in .
Ma non so come inserirlo per evitare di doverlo "attivare" ogni volta dalle File/opzioni/componenti aggiuntivi/Sfoglia/ etc etc
Chiedevo quindi, è possibile "automatizzare" il tutto?
Grazie a tutti.
Function i2s(inches As Double, Optional sformat As Integer, Optional nofeet As Integer)
Dim tfisep 'seporator between the feet and inches
Dim tinsep 'seporator between the inches and fractional inches numerator
If sformat = 1 Then
tfisep = "-"
tinsep = " "
ElseIf sformat = 2 Then
tfisep = " "
tinsep = " "
ElseIf sformat = 3 Then
tfisep = ""
tinsep = " "
ElseIf sformat = 4 Then
tfisep = " "
tinsep = "-"
ElseIf sformat = 5 Then
tfisep = ""
tinsep = "-"
Else
tfisep = " - "
tinsep = " "
End If
'deal with negative values
Dim x 'used to build the return string
Dim a 'used to store the polarity of the answer
If (inches < 0) Then
x = "-"
a = -inches
Else
x = ""
a = inches
End If
Dim i 'holds the number of residual inches left over
If nofeet = 1 Then
i = a
Else
Dim f 'holds the number of feeet
f = Int(a / 12)
x = x + strt(f) + "'" + tfisep
'find the inches left over
i = a - (f * 12)
End If
'First check if it comes out to an even number of inches
If i = Int(i) Then
'no fractional inches
x = x + strt(i) + Chr(34)
Else
'next check if the number of inches is an even fraction
If (i * 256) = Int(i * 256) Then
Dim iw 'the whole number part of the residual inches
iw = Int(i)
x = x + strt(iw) + tinsep
Dim n 'the nominator of the fractional part of the inches
n = (i - iw) * 256
Dim d 'the denominator of the fractional part of the inches
d = 256
'reduce the faction
Do While (n > 1) And ((n / 2) = Int(n / 2))
n = n / 2
d = d / 2
Loop
x = x + strt(n) + "/" + strt(d) + Chr(34)
Else
'not a fraction, so show the decimal
x = x + strt(i) + Chr(34)
End If
End If
i2s = x
End Function
Private Function strt(i)
strt = Trim(Str(i))
End Function
Private Function parsenum(s As String)
Dim errorflag 'remeber if we hit any errors while decoding the string
errorflag = False
Dim i 'loop var
For i = 1 To Len(s)
Dim c 'step throuhg the string one char at a time and check to make sure all are in range
c = Mid(s, i, 1)
If ((c < "0" Or c > "9") And (c <> ".")) Then
errorflag = True
End If
Next i
If errorflag = True Then
parsenum = CVErr(xlErrNA)
Else
parsenum = Val(s)
End If
End Function
'Convert string to inches
'String in the format 12' 4 1/2"
Function s2i(s As String) As Double
' n = positive or negative
' f= number of feet
' i = number of whole inches
' ifract = fracitonal or decimal inches part
' Get rid of any leading or trailing spaces
s = Trim(s)
Dim n 'save sign of result
If (Len(s) > 0) And Left(s, 1) = "-" Then
n = -1
s = Trim(Mid(s, 2))
Else
n = 1
End If
Dim fp 'feet portion pointer
Dim f 'number of feet
fp = InStr(s, "'")
If (fp > 0) Then
f = parsenum(Left(s, fp - 1))
'f could be an error here - we'll deal with it later
s = Trim(Mid(s, fp + 1))
If (Left(s, 1) = "-") Then
s = Trim(Mid(s, 2))
End If
Else
f = 0
End If
Dim i 'whole number of inches
Dim ifract 'fractional inches
Dim inom 'nominator of fractuional inches
Dim idenom 'nominator of fractuional inches
Dim idec 'decimal portion of inches
If (Len(s) = 0) Then 'just feet, no inches...
i = 0
ifract = 0
Else
'the string must end with a " or it is an error
If Not Right(s, 1) = Chr(34) Then
i = CVErr(xlErrNA)
inom = 0
idenom = 0
idec = 0
Else
'get rid of the "
s = Left(s, Len(s) - 1)
'find space
Dim sp 'space pointer
sp = InStr(s, " ")
'next look for a fractional part
Dim bp 'fraction break pointer
bp = InStr(s, "/")
If bp = 0 And sp = 0 Then 'just a whole number inches? (no space or /)
i = parsenum(s)
ifract = 0
ElseIf bp > 0 And sp > 0 Then 'whole number with fraction?
'The space should never come after the /
If sp > bp Then
i = CVErr(xlErrNA)
ifract = CVErr(xlErrNA)
Else
'get the nom and denom
inom = parsenum(LTrim(Mid(s, sp + 1, bp - sp - 1)))
idenom = parsenum(Mid(s, bp + 1))
If idenom = 0 Then 'dont allow zero denominator
ifract = CVErr(xlErrNA)
Else
ifract = inom / idenom
End If
End If
i = parsenum(Trim(Left(s, sp)))
ElseIf sp = 0 And bp > 0 Then 'just fractional inches part with no whole number?
'get the nom and denom
i = 0
inom = parsenum(LTrim(Mid(s, 1, bp - 1)))
idenom = parsenum(Trim(Mid(s, bp + 1)))
If (idenom = 0) Then
ifract = CVErr(xlErrNA)
Else
ifract = inom / idenom
End If
Else 'fractional part was improperly formatted
i = CVErr(xlErrNA)
ifract = CVErr(xlErrNA)
End If
End If
End If
s2i = ((f * 12) + (i) + (ifract)) * n
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
è da molto che non chiedevo un aiuto a voi che in passato avete risolto molti miei problemi.
questa volta volevo chiedere un favore, io devo convertire da pollici a inches dei valori per poi riconvertirli in millimetri.
Ora, io ho trovato un plug-in che fa ciò che mi serve, ma ho il problema di doverlo attivare ogni volta e se un mio collega apre lo stesso file si trova con degli errori...
Son riuscito quindi a leggere questo codice qua nel Plug-in .
Ma non so come inserirlo per evitare di doverlo "attivare" ogni volta dalle File/opzioni/componenti aggiuntivi/Sfoglia/ etc etc
Chiedevo quindi, è possibile "automatizzare" il tutto?
Grazie a tutti.
Function i2s(inches As Double, Optional sformat As Integer, Optional nofeet As Integer)
Dim tfisep 'seporator between the feet and inches
Dim tinsep 'seporator between the inches and fractional inches numerator
If sformat = 1 Then
tfisep = "-"
tinsep = " "
ElseIf sformat = 2 Then
tfisep = " "
tinsep = " "
ElseIf sformat = 3 Then
tfisep = ""
tinsep = " "
ElseIf sformat = 4 Then
tfisep = " "
tinsep = "-"
ElseIf sformat = 5 Then
tfisep = ""
tinsep = "-"
Else
tfisep = " - "
tinsep = " "
End If
'deal with negative values
Dim x 'used to build the return string
Dim a 'used to store the polarity of the answer
If (inches < 0) Then
x = "-"
a = -inches
Else
x = ""
a = inches
End If
Dim i 'holds the number of residual inches left over
If nofeet = 1 Then
i = a
Else
Dim f 'holds the number of feeet
f = Int(a / 12)
x = x + strt(f) + "'" + tfisep
'find the inches left over
i = a - (f * 12)
End If
'First check if it comes out to an even number of inches
If i = Int(i) Then
'no fractional inches
x = x + strt(i) + Chr(34)
Else
'next check if the number of inches is an even fraction
If (i * 256) = Int(i * 256) Then
Dim iw 'the whole number part of the residual inches
iw = Int(i)
x = x + strt(iw) + tinsep
Dim n 'the nominator of the fractional part of the inches
n = (i - iw) * 256
Dim d 'the denominator of the fractional part of the inches
d = 256
'reduce the faction
Do While (n > 1) And ((n / 2) = Int(n / 2))
n = n / 2
d = d / 2
Loop
x = x + strt(n) + "/" + strt(d) + Chr(34)
Else
'not a fraction, so show the decimal
x = x + strt(i) + Chr(34)
End If
End If
i2s = x
End Function
Private Function strt(i)
strt = Trim(Str(i))
End Function
Private Function parsenum(s As String)
Dim errorflag 'remeber if we hit any errors while decoding the string
errorflag = False
Dim i 'loop var
For i = 1 To Len(s)
Dim c 'step throuhg the string one char at a time and check to make sure all are in range
c = Mid(s, i, 1)
If ((c < "0" Or c > "9") And (c <> ".")) Then
errorflag = True
End If
Next i
If errorflag = True Then
parsenum = CVErr(xlErrNA)
Else
parsenum = Val(s)
End If
End Function
'Convert string to inches
'String in the format 12' 4 1/2"
Function s2i(s As String) As Double
' n = positive or negative
' f= number of feet
' i = number of whole inches
' ifract = fracitonal or decimal inches part
' Get rid of any leading or trailing spaces
s = Trim(s)
Dim n 'save sign of result
If (Len(s) > 0) And Left(s, 1) = "-" Then
n = -1
s = Trim(Mid(s, 2))
Else
n = 1
End If
Dim fp 'feet portion pointer
Dim f 'number of feet
fp = InStr(s, "'")
If (fp > 0) Then
f = parsenum(Left(s, fp - 1))
'f could be an error here - we'll deal with it later
s = Trim(Mid(s, fp + 1))
If (Left(s, 1) = "-") Then
s = Trim(Mid(s, 2))
End If
Else
f = 0
End If
Dim i 'whole number of inches
Dim ifract 'fractional inches
Dim inom 'nominator of fractuional inches
Dim idenom 'nominator of fractuional inches
Dim idec 'decimal portion of inches
If (Len(s) = 0) Then 'just feet, no inches...
i = 0
ifract = 0
Else
'the string must end with a " or it is an error
If Not Right(s, 1) = Chr(34) Then
i = CVErr(xlErrNA)
inom = 0
idenom = 0
idec = 0
Else
'get rid of the "
s = Left(s, Len(s) - 1)
'find space
Dim sp 'space pointer
sp = InStr(s, " ")
'next look for a fractional part
Dim bp 'fraction break pointer
bp = InStr(s, "/")
If bp = 0 And sp = 0 Then 'just a whole number inches? (no space or /)
i = parsenum(s)
ifract = 0
ElseIf bp > 0 And sp > 0 Then 'whole number with fraction?
'The space should never come after the /
If sp > bp Then
i = CVErr(xlErrNA)
ifract = CVErr(xlErrNA)
Else
'get the nom and denom
inom = parsenum(LTrim(Mid(s, sp + 1, bp - sp - 1)))
idenom = parsenum(Mid(s, bp + 1))
If idenom = 0 Then 'dont allow zero denominator
ifract = CVErr(xlErrNA)
Else
ifract = inom / idenom
End If
End If
i = parsenum(Trim(Left(s, sp)))
ElseIf sp = 0 And bp > 0 Then 'just fractional inches part with no whole number?
'get the nom and denom
i = 0
inom = parsenum(LTrim(Mid(s, 1, bp - 1)))
idenom = parsenum(Trim(Mid(s, bp + 1)))
If (idenom = 0) Then
ifract = CVErr(xlErrNA)
Else
ifract = inom / idenom
End If
Else 'fractional part was improperly formatted
i = CVErr(xlErrNA)
ifract = CVErr(xlErrNA)
End If
End If
End If
s2i = ((f * 12) + (i) + (ifract)) * n
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub