Conversion macro Excel vers sheets
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 :)
- Conversion macro Excel vers sheets
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
1 réponse
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