Sujet Précédent Sujet Suivant

Formatage chaine caracteres aprés extraction d'un fichier

84mike Messages postés 1 Date d'inscription dimanche 10 mai 2015 Statut Membre Dernière intervention 10 mai 2015 - Modifié par jordane45 le 10/05/2015 à 15:28
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 10 mai 2015 à 19:20
Bonjour

Dans le sub genere - je voudrai extraire une chaine de 50 caractères de la cellule B de la ligne Fourn et l'ecrire dans le nouveau fichier. Que faire?

Merci d'avance


'Génère un fichier contenant toutes les fournitures renseignées 
Public Sub Genere()

Dim fourn() As String
Dim NomFich As String
Dim Chemin As String
    
    'Récupèration des fournitures
    fourn = RecupFourn
    
    
    'Récupère le nom du fichier
    NomFich = Range("Fichier")
    
    If NomFich = "" Then
        MsgBox "Saisir le nom du fichier à créer"
        Exit Sub
    End If

    'Créer le chemin du nouveau fichier (même endroit que le fichier actuel)
    Chemin = ThisWorkbook.Path & "\" & NomFich & ".xls"

    'Crée un nouveau fichier Excel
    CreerFich
      
    'Transfère les données dans le fichier
     With Sheets("Commande")
  
      .Range("A1", "D" & CStr(UBound(fourn, 2) + 1)) = Application.WorksheetFunction.Transpose(fourn)
             
                
       .Range("E1") = "Observation"
       .Range("F1") = "Type"
         
     End With

    MiseEnForme
    MsgBox Chemin

    ActiveWorkbook.SaveAs Filename = Chemin, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
 '   ActiveWorkbook.Close
    
End Sub


'Récupère les lignes dont les quantités ont été renseignées
Private Function RecupFourn() As String()

Dim i As Integer
Dim Ligne() As String

    ReDim Preserve Ligne(3, 100)
    i = 0
    'Récupère les lignes avec des quantités
    For Each cel In Range("Quantite")
        If cel.Value <> "" Then
            Ligne(0, i) = cel.Offset(0, -2)
            Ligne(1, i) = cel.Offset(0, -1)
            Ligne(2, i) = cel
            Ligne(3, i) = cel.Offset(0, 1)
            i = i + 1
        End If
    Next cel
    ReDim Preserve Ligne(3, i - 1)
    
    RecupFourn = Ligne
    
End Function


'Efface toutes les quantités
Public Sub EffaceQté()

    If MsgBox("Voulez-vous supprimer toutes les quantités ?", vbYesNo, "Avertissement") = vbYes Then
        For Each cel In Range("Quantite")
            If cel.Value <> "Qté" Then
                cel.Value = ""
            End If
        Next cel
    End If

End Sub



'Création du nouveau fichier
Private Sub CreerFich()

    'Crée un nouveau fichier Excel
    Workbooks.Add
    Sheets("feuil1").Name = "Commande"
    Application.DisplayAlerts = False
   
    Application.DisplayAlerts = True

End Sub


'Mise en forme du fichier
Private Sub MiseEnForme()
    
    'Mise en forme des données
    Sheets("Commande").Range("A1", "F1").CurrentRegion.Select
    With Selection
     
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "arial"
        .Font.ColorIndex = 0
        .Font.Size = 10
        .Columns(1).ColumnWidth = 24
        .Columns(2).ColumnWidth = 50
        .Columns(2).HorizontalAlignment = xlLeft
        .Columns(3).ColumnWidth = 10
        .Columns(4).ColumnWidth = 35
        .Columns(5).ColumnWidth = 16
        .Columns(6).ColumnWidth = 8
        ' .EntireColumn.AutoFit
    End With
    'Mise en forme des titres
    Sheets("Commande").Range("A1", "F1").Select
    With Selection
        .Font.FontStyle = "Gras"
        .Interior.ColorIndex = 9
        .Font.ColorIndex = 2
        .Font.Size = 12
        .Columns(2).HorizontalAlignment = xlCenter
      ' .EntireColumn.AutoFit
   End With
End Sub
Sub Début()
     Range("Début").Select
End Sub
Sub Fin()
     Range("Fin").Select
End Sub



EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici :
http://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

Merci d'y penser dans tes prochains messages.
.

1 réponse

Réponse 1 / 1
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
10 mai 2015 à 19:20
Bonjour,
Déja : 
 Dim Ligne() As String

    ReDim Preserve Ligne(3, 100)

n'est autre que 
Dim Ligne(3,100) As String


que penses-tu faire avec : 
 ReDim Preserve Ligne(3, i - 1)

?
Commence par répondre à cela .
0

Discussions similaires

parcourir une chaîne de caractère lettre par lettre
nournina -
nournina -

3 réponses
extraction d'une partie d'une chaine dans une chaine
cs_berserk14 -
Aide -

4 réponses
chaine de caractère
Thomeux -
aera group -

1 réponse
Trouver toutes les positions d'une lettre dans une chaine
Zgo -
Gandalfix -

2 réponses
Ouvrir un fichier java
cs_yokaze -
yokaze -

6 réponses
Rejoignez-nous