Bonjour,
Voici le code, mon souci est lorsque je charge l'Userform sans le show 0, le traitement ne se réalise pas mais par contre l'userform s'affiche correctement et au contraire si je place avec l'option 0, le traitement s'effectue mais l'affichage n'est pas complet, l'interieur de l'userform reste blanc.
Voici le code, mon souci est lorsque je charge l'Userform sans le show 0, le traitement ne se réalise pas mais par contre l'userform s'affiche correctement et au contraire si je place avec l'option 0, le traitement s'effectue mais l'affichage n'est pas complet, l'interieur de l'userform reste blanc.
VB:
Sub Macro2()
'
' Macro2 Macro
Application.ScreenUpdating = False
' variables pour séparation num de la rue
Dim FL1 As Worksheet, Cell As Range, Plage As Range
Dim Var1, Var2, Var3, Var4, Var5, Adresse, Cible, EtatBac As String
Dim i, fin As Integer
'
UserForm1.Show 0 ' affiche traitement en cours
' Touche de raccourci du clavier: Ctrl+k
' Importation : le classeur export.xls doit être ouvert
Call importation
' Numéro de ligne import
i = 2
fin = Range("A65536").End(xlUp).Row ' fin de fichier d'exportation
Set FL1 = Worksheets("Feuil1")
With FL1
'Détermination de la plage de cellules à lire
Set Plage = .Range("E2" & ":" & "E" & fin)
' Insert colonne Numéro Rue pour modification de chaine caractères Adresse
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 6.3
For Each Cell In Plage
'Valeur de la cellule lue
Adresse = Cell.Value
Var1 = Cell.Value
Var1 = Mid(Var1, 1, 2)
Var2 = Cell.Value
Var2 = Mid(Var2, 1, 3)
Var3 = Cell.Value
Var3 = Mid(Var3, 1, 4)
Var4 = Cell.Value
Var4 = Mid(Var4, 1, 5)
Var5 = Cell.Value
Var5 = Mid(Var5, 1, 6)
EtatBac = Cell.Value
EtatBac = Range("H" & i)
' traitement si Bis au lieu de B et Ter au lieu de T pour numéro de rue à un chiffre
If Mid(Adresse, 3, 3) = "Bis" Or Mid(Adresse, 3, 3) = "BIS" Or Mid(Adresse, 3, 3) = "Ter" Or Mid(Adresse, 3, 3) = "TER" And Mid(Adresse, 6, 1) = " " Then
Range("E" & i) = Left(Var4, 5)
Adresse = Mid(Adresse, 6)
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
Else
' traitement pour numéro à 2 chiffres
If Mid(Adresse, 4, 3) = "Bis" Or Mid(Adresse, 4, 3) = "BIS" Or Mid(Adresse, 4, 3) = "Ter" Or Mid(Adresse, 4, 3) = "TER" And Mid(Adresse, 7, 1) = " " Then
Range("E" & i) = Left(Var5, 6)
Adresse = Mid(Adresse, 7)
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
Else
' traitement valeur normale ex: 1 ou 22 rue toto
If Val(Var1) <> 0 Then
Range("E" & i) = Var1
Adresse = Replace(Adresse, Var1, "")
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
End If
' traitemant valeur erreur saisie num rue ex: 3 5 rue
If Mid(Var3, 4, 1) = " " And Val(Var1) <> 0 Then
Var2 = Replace(Var2, " ", "")
Range("E" & i) = Var2
Adresse = Replace(Adresse, Mid(Adresse, 1, 1), "")
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
End If
' traitement num rue bis, A, T ex : 2 A rue
If (Mid(Var2, 3, 1) = "A") And Mid(Var2, 4, 1) = " " Then
Var2 = Replace(Var2, " ", "")
If Mid(Var2, 4, 1) = "A" Then
Adresse = Replace(Adresse, "A ", "")
End If
If Mid(Var2, 4, 1) = "B" Then
Adresse = Replace(Adresse, "B ", "")
End If
If Mid(Var2, 4, 1) = "T" Then
Adresse = Replace(Adresse, "T ", "")
End If
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
Range("E" & i) = Var2
End If
' traitement valeur ex: 62 A rue
If (Mid(Var3, 4, 1) = "A") Or (Mid(Var3, 4, 1) = "B") Or (Mid(Var3, 4, 1) = "T") Then
If Mid(Var3, 4, 1) = "A" Then
Adresse = Replace(Adresse, "A ", "")
End If
If Mid(Var3, 4, 1) = "B" Then
Adresse = Replace(Adresse, "B ", "")
End If
If Mid(Var3, 4, 1) = "T" Then
Adresse = Replace(Adresse, "T ", "")
End If
Adresse = LTrim(Adresse)
Range("F" & i) = Adresse
Cells(i, "E").NumberFormat = "@" ' conserver Format Texte
Range("E" & i) = Var3
End If
End If
End If
' Centre le numéro de rue à droite
Range("E" & i).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
i = i + 1
Next
End With
Call TriBacs
' Préparation de l'impression
Call Imprimer
Unload UserForm1
Set FL1 = Nothing
Set Plage = Nothing
End Sub
Dernière édition: