Effectuer des contrôles
Le_Goret
-
Le_Goret -
Le_Goret -
Bonjour,
J'effectue tous les mathins les mêmes contrôles sur une feuille excel. Je ne supporte plus de faire la même chose!!! Débutant en programmation VBA je voudrais commencer par une macro toute simple pour l'étoffer petit à petit.
Je voudrais donc commencer par le premier contrôle que je fais:
Vérifier que mon tableau ne fasse pas plus de 1000 lignes. Si c'est bon, je duplique ma feuille Excel par autant de points de ventes présents. J'ai deux macros qui marchent parfaitement:
Macro 1:
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
End Sub
Macro 2
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub
Voici la compilation de mes 2 macros:
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub
Lorsque je la lance j'ai un message d'erreur qui s'affiche: erreur'13', incompatibilié de type. C'est au niveau de la syntaxe que ca doit coincer.
Quelqu'un peut-il me donner un coup de main?
Cordialement,
Le_Goret
J'effectue tous les mathins les mêmes contrôles sur une feuille excel. Je ne supporte plus de faire la même chose!!! Débutant en programmation VBA je voudrais commencer par une macro toute simple pour l'étoffer petit à petit.
Je voudrais donc commencer par le premier contrôle que je fais:
Vérifier que mon tableau ne fasse pas plus de 1000 lignes. Si c'est bon, je duplique ma feuille Excel par autant de points de ventes présents. J'ai deux macros qui marchent parfaitement:
Macro 1:
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
End Sub
Macro 2
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub
Voici la compilation de mes 2 macros:
Private Sub CommandButton1_Click()
Dim RgT As Range, N As Long, C As Long, FeuiR As Worksheet
Set RgT = Feuil1.[H8].CurrentRegion
Set RgT = Range(Feuil1.Rows(8), RgT.Rows(RgT.Rows.Count))
If RgT.Rows.Count > 1000 Then MsgBox "Le tableau comporte plus de 1000 lignes"
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Next C
End Sub
Lorsque je la lance j'ai un message d'erreur qui s'affiche: erreur'13', incompatibilié de type. C'est au niveau de la syntaxe que ca doit coincer.
Quelqu'un peut-il me donner un coup de main?
Cordialement,
Le_Goret
A voir également:
- Effectuer des contrôles
- Vous devez disposer d'une autorisation pour effectuer cette action - Guide
- Steam doit être en ligne pour effectuer la mise à jour ✓ - Forum jeux en ligne
- Impossible d'effectuer l'opération le message ayant été modifié ✓ - Forum Outlook
- Nous limitons la fréquence de certaines actions que vous pouvez effectuer sur instagram - Forum Instagram
- Votre solde est insuffisant pour effectuer cette operation. veuillez recharger votre compte. - Forum Illustrator
2 réponses
Bonjour
RgT est bizarre...
rgt est dékarée en Range
Et là
RgT = Cells(6, C).Value si tu demande la valeur Rgt n'est plus une "range" ==> incompatibilité de type
mais ta macro parait bien compliqué...
RgT est bizarre...
rgt est dékarée en Range
Et là
RgT = Cells(6, C).Value si tu demande la valeur Rgt n'est plus une "range" ==> incompatibilité de type
mais ta macro parait bien compliqué...
Les bureaux sont bien vides en ce vendredi matin. Je fais un tour sur les forums et je me rends compte que j'ai publié des posts que je ne suis plus allé voir par la suite.
Je suis bien arrivé à finaliser cette macro. A partir d'une base de données cette macro va créer un onglet spécifique à chaque colonne. Chaque ligne dont une valeur est à 0 est supprimée. J'ai apporté une nouvelle modification: un tableau croisé dynamique est crée pour chacun de ces onglets. Voici le code ca peut aider quelqu'un.
Voici ma maquette. Il suffit de cliquer sur le premier bouton contrôle.
http://www.cijoint.fr/cjlink.php?file=cj201104/cijFFxD0Yd.xls
Private Sub CommandButton1_Click()
Dim RgT As String, N As Long, C As Long, FeuiR As Worksheet
Dim Adr As String 'Source
Dim Adr1 As String 'Destination
Dim PT As PivotTable
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT & "TCD"
'suppression des lignes avec quantités a zero
Sheets(RgT).Select
Sheets(RgT).Activate
'With Worksheets(RgT)
Dim dl As Integer 'déclare la variable dl
Dim x As Integer 'déclare la variable x
dl = Range("I65536").End(xlUp).Row 'définit la variable x (dernière ligne remplie (colonne à adapter))
For x = dl To 8 Step -1
'si la cellule de la ligne x, colonne 15 ("I") est nulle, supprime la ligne
If Sheets(RgT).Cells(x, 15).Value = 0 Then
Sheets(RgT).Rows(x).Delete
End If
Next x 'prochaine ligne de la boucle
'End With
' Tableaucroisédynamique Macro
Name = "Tcd " & C
Dest = RgT & "!A3"
Sheets(RgT).Select
'Définir où sera copié le pivottable
With Worksheets(RgT)
Adr1 = .Name & "TCD!" & .Range("A3").Address
End With
'Définir où sont les données pour le pivotcache
With Worksheets(RgT)
Adr = .Name & "!" & .Range("F7:O" & _
.Range("O65536").End(xlUp).Row).Address
'Adr = .Name & "!" & .Range("F7:O" & .Range("O65536").End(xlUp).Row).Address
'...
'..., SourceData:=Range(Adr))
'Écrivez plutôt :
'Code VBA:
'Set MaPlageSource = .Range("F7:O" & .Range("O65536").End(xlUp).Row)
'...
'..., SourceData:=MaPlageSource)
End With
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Adr).CreatePivotTable TableDestination:= _
"'" & RgT & "TCD'!R3C1", TableName:= _
RgT, DefaultVersion:=xlPivotTableVersion10
Sheets(RgT & "TCD").Select
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveSheet.PivotTables(RgT).PivotFields("Impl."). _
Orientation = xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.PivotTables(RgT).PivotFields("RCT"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields("Période"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields( _
"Date Livraison").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveWorkbook.ShowPivotTableFieldList = False
Next C
End Sub
Je suis bien arrivé à finaliser cette macro. A partir d'une base de données cette macro va créer un onglet spécifique à chaque colonne. Chaque ligne dont une valeur est à 0 est supprimée. J'ai apporté une nouvelle modification: un tableau croisé dynamique est crée pour chacun de ces onglets. Voici le code ca peut aider quelqu'un.
Voici ma maquette. Il suffit de cliquer sur le premier bouton contrôle.
http://www.cijoint.fr/cjlink.php?file=cj201104/cijFFxD0Yd.xls
Private Sub CommandButton1_Click()
Dim RgT As String, N As Long, C As Long, FeuiR As Worksheet
Dim Adr As String 'Source
Dim Adr1 As String 'Destination
Dim PT As PivotTable
For C = 15 To 256
RgT = Cells(6, C).Value
If RgT = "" Then
Exit For
End If
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT
Feuil1.Columns(1).Resize(, 14).Copy FeuiR.Columns(1)
Feuil1.Columns(C).Copy FeuiR.Columns(15)
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT & "TCD"
'suppression des lignes avec quantités a zero
Sheets(RgT).Select
Sheets(RgT).Activate
'With Worksheets(RgT)
Dim dl As Integer 'déclare la variable dl
Dim x As Integer 'déclare la variable x
dl = Range("I65536").End(xlUp).Row 'définit la variable x (dernière ligne remplie (colonne à adapter))
For x = dl To 8 Step -1
'si la cellule de la ligne x, colonne 15 ("I") est nulle, supprime la ligne
If Sheets(RgT).Cells(x, 15).Value = 0 Then
Sheets(RgT).Rows(x).Delete
End If
Next x 'prochaine ligne de la boucle
'End With
' Tableaucroisédynamique Macro
Name = "Tcd " & C
Dest = RgT & "!A3"
Sheets(RgT).Select
'Définir où sera copié le pivottable
With Worksheets(RgT)
Adr1 = .Name & "TCD!" & .Range("A3").Address
End With
'Définir où sont les données pour le pivotcache
With Worksheets(RgT)
Adr = .Name & "!" & .Range("F7:O" & _
.Range("O65536").End(xlUp).Row).Address
'Adr = .Name & "!" & .Range("F7:O" & .Range("O65536").End(xlUp).Row).Address
'...
'..., SourceData:=Range(Adr))
'Écrivez plutôt :
'Code VBA:
'Set MaPlageSource = .Range("F7:O" & .Range("O65536").End(xlUp).Row)
'...
'..., SourceData:=MaPlageSource)
End With
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
Adr).CreatePivotTable TableDestination:= _
"'" & RgT & "TCD'!R3C1", TableName:= _
RgT, DefaultVersion:=xlPivotTableVersion10
Sheets(RgT & "TCD").Select
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveSheet.PivotTables(RgT).PivotFields("Impl."). _
Orientation = xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.PivotTables(RgT).PivotFields("RCT"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields("Période"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables(RgT).PivotFields( _
"Date Livraison").Subtotals = Array(False, False, False, False, False, False, False, _
False, False, False, False, False)
ActiveSheet.PivotTables(RgT).AddFields RowFields:= _
Array("Période", "Date Livraison", "RCT")
ActiveWorkbook.ShowPivotTableFieldList = False
Next C
End Sub
Quand tu dis que ma macro est compliquée tu entends par là qu'elle peut être simplifiée?
rgt_nom=cells(6,C)
Set FeuiR = Worksheets.Add
FeuiR.Name = RgT_nom
Quand tu dis que ma macro est compliquée tu entends par là qu'elle peut être simplifiée?
oui, mais il faudrait voir ta feuille