Formatage chaine caracteres aprés extraction d'un fichier

Signaler
Messages postés
1
Date d'inscription
dimanche 10 mai 2015
Statut
Membre
Dernière intervention
10 mai 2015
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
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

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
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 .