Conversion macro Excel vers sheets

VG -  
Willzac Messages postés 266 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour à tous,

Je viens vers vous pour vous demander votre aide.

Actuellement je travail sur Excel mais je dois passer sur Sheets. j'ai un tableur qui comporte plusieurs feuille où je remplis plusieurs lignes avec plusieurs cellules.  Ensuite je lance une macro qui me génère, en fonction de certaine cellules, des lignes supplémentaires sous les lignes renseignées avec comme référence une autre feuille. La génération ne ce fait pas automatiquement, je passe par une "box" pour sélectionner centaine colonne.

 c'est pour cela que je vous demande votre aide pour convertir cette macro en java, ci dessous la marco.

Public Sub BOUTONGENERER_Click()

'Déclaration de variable
erreur = 0
Dim derniereLigne As Long
Dim compteurDePasTrouve As Long


If TEXTBOXSELECTIONONGLET.Text = "" Then
MsgBox "Pas de fichier Excel désigné", vbOKOnly + vbInformation, "Erreur"

Else

Windows(SOURCE.Caption).Activate 'LISTE EQUIPEMENT SO KLE
Sheets(TEXTBOXSELECTIONONGLET.Text).Select
Set ws1 = Worksheets(TEXTBOXSELECTIONONGLET.Text)

Windows("Liste des équipements .xlsm").Activate 'REFERENCIEL
Sheets("Ref").Select
Set ws2 = Worksheets("Ref")

Windows(SOURCE.Caption).Activate 'LISTE EQUIPEMENT SO KLE
Sheets(TEXTBOXSELECTIONONGLET.Text).Select
Application.DisplayAlerts = False

'Création de la barre de chargement
Image1.Width = 0
Générateur.Height = 185.25
derniereLigne = ws1.[C65536].End(xlUp).Row - 11
uneLigne = (1 / derniereLigne) * 100
DoEvents


For A = 12 To 20000
'---------------------------------------------------------------------------------------------------------------
    If Range(mNemonique.Text & A).Text = "" And Not Range(designation.Text & A).Text = "" And Not Range(designation.Text & A).Text Like "*""*" Then
        'Si il reconnait pas alors on saute
        Range(mNemonique.Text & A).Interior.Color = RGB(236, 0, 0)
        Image1.Width = Image1.Width + uneLigne
        erreur = erreur + 1
        Label3.Caption = "Erreurs :" & " " & erreur
    ElseIf Range(typeEquipement.Text & A).Text = "" And Not Range(mNemonique.Text & A).Text = "" Then
        'Si il reconnait pas alors on saute
        Range(mNemonique.Text & A).Interior.Color = RGB(236, 0, 0)
        Image1.Width = Image1.Width + uneLigne
        erreur = erreur + 1
        Label3.Caption = "Erreurs :" & " " & erreur
    ElseIf Range(mNemonique.Text & A).Text = "" Then 'Mnemo trouvé dans la liste
    Else

        Dim mNemo As String
        
        If Range(designation.Text & A + 1) Like "*""*" Then 'Vérification si il est déjà fait ou non
        
        Else
            mNemo = Range(typeEquipement.Text & A).Text
            If mNemo = "MOTEUR" Or mNemo = "VARIATEUR" Or mNemo = "MOTEUR_2S" Then 'C'est un moteur alors prise de l'alim.
                mNemo = Range(alimentation.Text & A).Text
            Else 'C'est autre chose alors prise du mnemo
                mNemo = Range(mNemonique.Text & A).Text
            End If
                
            Windows("Liste des équipements .xlsm").Activate 'REFERENCIEL
            Sheets("Ref").Select
            
                For hug = 1 To 20000
                    If Range("A" & hug).Text = mNemo Then
                        For prout = 1 To 20000 'Compte le nombre de ligne à copier
                            If Range(designation & hug + prout) = "" Then
                                CptDeLigne = CptDeLigne + 1
                                Exit For
                            Else
                                CptDeLigne = CptDeLigne + 1
                            End If
                        Next prout
                        
                        Windows(SOURCE.Caption).Activate 'LISTE EQUIPEMENT SO KLE
                        Sheets(TEXTBOXSELECTIONONGLET.Text).Select

                        For loulou = 1 To CptDeLigne 'Insert les lignes comptées
                            Rows(A + 1 & ":" & A + 1).Select
                            Application.CutCopyMode = False
                            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Next loulou
                
                        Windows("Liste des équipements .xlsm").Activate 'REFERENCIEL
                        Sheets("Ref").Select
                
                        Rows(hug + 1 & ":" & hug + CptDeLigne).Select 'Copie les lignes
                        Application.CutCopyMode = False
                        Selection.Copy
                        Windows(SOURCE.Caption).Activate 'LISTE EQUIPEMENT SO KLE
                        Sheets(TEXTBOXSELECTIONONGLET.Text).Select
                        Rows(A + 1 & ":" & A + CptDeLigne).Select 'Colle les lignes
                        ActiveSheet.Paste
                        Image1.Width = Image1.Width + uneLigne
                        DoEvents
                        Exit For
                    ElseIf Range("A" & hug).Text = "FIN" Then
                        Windows(SOURCE.Caption).Activate 'LISTE EQUIPEMENT SO KLE
                        Sheets(TEXTBOXSELECTIONONGLET.Text).Select
                        Range(mNemonique.Text & A).Interior.Color = RGB(236, 0, 0)
                        erreur = erreur + 1
                        Exit For
                    End If
                Next hug
            End If
        End If
    CptDeLigne = 0

'---------------------------------------------------------------------------------------------------------------
    
    If Range(mNemonique.Text & A).Text = "" Then
        cptVide = cptVide + 1
    Else:
        cptVide = 0
    End If
    If cptVide > 200 Then
        Exit For
    End If
Next A
Générateur.Height = 157.5
End If
End Sub


Private Sub Image1_Click()

End Sub


Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub Label3_Click()

End Sub
Private Sub mNemonique_Change()

End Sub
Private Sub designation_Change()

End Sub
Private Sub alimentation_Change()

End Sub
Private Sub typeEquipement_Change()

End Sub

Private Sub TEXTBOXSELECTIONONGLET_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not ActiveWorkbook.ActiveSheet.Name = "" Then
    TEXTBOXSELECTIONONGLET.Text = ActiveWorkbook.ActiveSheet.Name
    SOURCE.Caption = ActiveWorkbook.Name
    SOURCE.ForeColor = &HFF0000
Else
    TEXTBOXSELECTIONONGLET.Text = "Réessayez"
End If

End Sub
Private Sub SOURCE_Click()

End Sub


Private Sub UserForm_Click()

End Sub
 

Merci de votre aide :)

A voir également:

1 réponse

Willzac Messages postés 266 Date d'inscription   Statut Membre Dernière intervention   14
 

Bonsoir,

J'ai pas lu jusqu'à la fin mais il se peut que l'exécution de votre code mettra beaucoup de temps.

Pour gagner en temps, mettez :

Application.ScreenUpdating = False

avant la boucle For A = 12 To 20000

et :

Application.ScreenUpdating = True

 avant la fermeture de votre code (avant End sub)

Cordialement

Willzac


0