crée un petit prog vb

zumye · 21 Avril 2009

bonjour le forum

j'ai un petit vba à créer:

dans la cellulle AQ1 uniquement j'ai ce genre information qui arrive:

Longueur actuelle: 2.86, angle décrit: 68
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 1.45, angle décrit: 40
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 2.70, angle décrit: 39
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 3.04
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 2.09, angle décrit: 58
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 3.69, angle décrit: 72
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 4.31, angle décrit: 86
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 1.66, angle décrit: 37
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 2.83, angle décrit: 71
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 3.57, angle décrit: 63
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 3.35, angle décrit: 49
Sélectionnez un objet ou [DIfférence/Pourcentage/TOtal/DYnamique]:
Longueur actuelle: 2.59, angle décrit: 45

ce sont les longueurs autocad
j'aimerai que le vba me permette de sortir chaque longueur comme ceci en prenant l'exemple:

en AQ2=2.86
en AQ3=1.45
etc

merci

mromain · 21 Avril 2009

Re : crée un petit prog vb

bonjour zumye,

je te propose cette macro :

Code:

Sub test()
Dim texteAQ1 As String, lignesTab, tmpStr As String, i As Integer, curCell As Range

texteAQ1 = ActiveSheet.Range("AQ1").Value
Set curCell = ActiveSheet.Range("AQ2")

lignesTab = Split(texteAQ1, Chr(10))
For i = LBound(lignesTab) To UBound(lignesTab)
    If InStr(lignesTab(i), "Longueur actuelle: ") Then
        tmpStr = Right(lignesTab(i), Len(lignesTab(i)) - Len("Longueur actuelle: "))
        If InStr(tmpStr, ",") Then tmpStr = Mid(tmpStr, 1, InStr(tmpStr, ",") - 1)
        curCell.Value = tmpStr
        Set curCell = curCell.Offset(1, 0)
    End If
Next i
End Sub

a+

vbacrumble · 21 Avril 2009

Re : crée un petit prog vb

Bonjour à tous

En utilisant VBA et Données/Convertir

Code:

Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 21/04/2009 par VBACrumble
'

'
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=":", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 9))
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=",", FieldInfo:=Array(Array(1, 1), Array(2, 9))
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
End Sub

zumye · 21 Avril 2009

Re : crée un petit prog vb

merci pour les reponses ca marche bien

crée un petit prog vb

zumye

XLDnaute Occasionnel

mromain

XLDnaute Barbatruc

vbacrumble

XLDnaute Accro

zumye

XLDnaute Occasionnel