Erreur d'exécution 1004 VBA

Le 05/06/2019 à 14:14

Bonjour,

J'ai créé un bouton pour extraire des fichiers mais dès que mon txt est extrait mes boutons refuse de fonctionnez et ça m'afficher erreur d'exécution 1004 : erreur définie par l'application ou objet. Et je ne vois pas d'où le problème peut venir

merci d'avance

Le 05/06/2019 à 14:20

Bonjour tissy,

D'après ma boule de cristal je dirais que le code est mauvais

Blague à part, si tu veux une réponse efficace, fournit un fichier, car sans voir le code on ne peut pas t'aider

Le 05/06/2019 à 14:41

Voici le code :

Private Sub Fev_Click()

Dim i As Integer

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _

"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""BFR 02"";Extended Properties=""""" _

, Destination:=Range("$A$1")).QueryTable

.CommandType = xlCmdSql

.CommandText = Array("SELECT * FROM [BFR 02]")

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

.Refresh BackgroundQuery:=False

End With

For i = 1000 To 2 Step -1

If Cells(i, 1).Value Like "1*" Then Rows(i).Delete

If Cells(i, 1).Value Like "2*" Then Rows(i).Delete

If Cells(i, 1).Value Like "6*" Then Rows(i).Delete

If Cells(i, 1).Value Like "7*" Then Rows(i).Delete

'Efface les cellules de la classe 1,2,6,7

Next i

For i = 1000 To 2 Step -1

If Cells(i, 1).Value Like "5*" Then Rows(i).Interior.Color = RGB(255, 0, 0)

If Cells(i, 1).Value Like "45*" Then Rows(i).Interior.Color = RGB(255, 0, 0)

Next i

For i = 1000 To 2 Step -1

If Cells(i, 8).Value = "C" Then Cells(i, 7).Value = Cells(i, 7) * -1

'Mettre certaines valeurs positives en négatives

Next i

Range("I3").Value = Cells(3, 7).Value + Cells(2, 7).Value

Range("I9").Value = Cells(8, 7).Value + Cells(9, 7).Value + Cells(12, 7).Value + Cells(13, 7).Value

Range("I11").Value = Cells(4, 7).Value + Cells(5, 7).Value + Cells(6, 7).Value + Cells(10, 7).Value + Cells(11, 7).Value

Range("I15").Value = Cells(15, 7).Value

Range("I20").Value = Cells(14, 7).Value + Cells(16, 7).Value + Cells(17, 7).Value + Cells(18, 7).Value + Cells(19, 7).Value + Cells(20, 7).Value

Range("I26").Value = Cells(21, 7).Value + Cells(22, 7).Value + Cells(23, 7).Value + Cells(24, 7).Value + Cells(25, 7).Value + Cells(26, 7).Value

'calcul des cellules précises

Range("J3") = "Stock MP"

Range("J9") = "Stock"

Range("J11") = "Stock"

Range("J15") = "FRS Immo"

Range("J20") = "Fournisseurs"

Range("J26") = "Clients"

'Nomme certaines cellules

For i = 1000 To 2 Step -1

If Cells(i, 1).Value Like "31*" Then Rows(i).Font.ColorIndex = 32

If Cells(i, 1).Value Like "35*" Then Rows(i).Font.ColorIndex = 38

If Cells(i, 1).Value Like "40*" Then Rows(i).Font.ColorIndex = 43

If Cells(i, 1).Value Like "404*" Then Rows(i).Font.ColorIndex = 3

If Cells(i, 1).Value Like "41*" Then Rows(i).Font.ColorIndex = 46

'Attribue une couleur à cellule plages de cellules

Next i

Range("J12").Value = Cells(3, 9).Value + Cells(9, 9).Value + Cells(11, 9).Value

Range("J60").Value = Cells(27, 7).Value + Cells(28, 7).Value + Cells(32, 7).Value + Cells(33, 7).Value + Cells(34, 7).Value + Cells(35, 7).Value + Cells(36, 7).Value + Cells(37, 7).Value + Cells(38, 7).Value + Cells(46, 7).Value + Cells(47, 7).Value + Cells(48, 7).Value + Cells(49, 7).Value + Cells(50, 7).Value + Cells(51, 7).Value + Cells(52, 7).Value + Cells(54, 7).Value + Cells(55, 7).Value + Cells(56, 7).Value + Cells(57, 7).Value + Cells(58, 7).Value + Cells(60, 7).Value

Range("J76").Value = Cells(62, 7).Value + Cells(63, 7).Value + Cells(70, 7).Value + Cells(75, 7).Value + Cells(76, 7).Value

Range("J87").Value = Cells(39, 7).Value + Cells(41, 7).Value + Cells(42, 7).Value + Cells(43, 7).Value + Cells(45, 7).Value + Cells(53, 7).Value + Cells(59, 7).Value + Cells(65, 7).Value + Cells(67, 7).Value + Cells(68, 7).Value + Cells(80, 7).Value + Cells(81, 7).Value + Cells(82, 7).Value + Cells(83, 7).Value + Cells(85, 7).Value + Cells(87, 7).Value

Range("J95").Value = Cells(78, 7).Value + Cells(84, 7).Value + Cells(86, 7).Value + Cells(88, 7).Value + Cells(89, 7).Value + Cells(90, 7).Value + Cells(95, 7).Value

'Addition

For i = 1000 To 2 Step -1

If Cells(i, 10).Value < 0 And Cells(i, 1).Value Like "44*" Then Cells(i, 11).Value = "A"

If Cells(i, 10).Value < 0 And Cells(i, 1).Value Like "46*" Then Cells(i, 11).Value = "B"

If Cells(i, 10).Value < 0 And Cells(i, 1).Value Like "48*" Then Cells(i, 11).Value = "B"

If Cells(i, 10).Value > 0 And Cells(i, 1).Value Like "42*" Then Cells(i, 11).Value = "C"

If Cells(i, 10).Value > 0 And Cells(i, 1).Value Like "43*" Then Cells(i, 11).Value = "C"

If Cells(i, 10).Value > 0 And Cells(i, 1).Value Like "44*" Then Cells(i, 11).Value = "C"

If Cells(i, 10).Value > 0 And Cells(i, 1).Value Like "46*" Then Cells(i, 11).Value = "C"

If Cells(i, 10).Value > 0 And Cells(i, 1).Value Like "48*" Then Cells(i, 11).Value = "C"

If Cells(i, 10).Value < 0 And Cells(i, 1).Value Like "42*" Then Cells(i, 11).Value = "D"

If Cells(i, 10).Value < 0 And Cells(i, 1).Value Like "43*" Then Cells(i, 11).Value = "D"

Next i

End Sub

Le 05/06/2019 à 14:45

Bonjour Tissy,

Pourrais-tu nous dire où se situe l'erreur

Le 05/06/2019 à 14:52

Nimajneb42 a écrit :
Bonjour Tissy,
Pourrais-tu nous dire où se situe l'erreur

je ne sais pas où se situe l'erreur, je peux éventuellement joindre le fichier si c'est plus simple

7bfr-2019-centre-sem-maite1.xlsm (344.70 Ko)

Le 05/06/2019 à 15:37

Florian53 a écrit :
Bonjour tissy,
D'après ma boule de cristal je dirais que le code est mauvais
Blague à part, si tu veux une réponse efficace, fournit un fichier, car sans voir le code on ne peut pas t'aider

je pense que l'erreur se situe à ce niveau :

Private Sub Fev_Click()

Dim i As Integer

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _

"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""BFR 02"";Extended Properties=""""" _

, Destination:=Range("$A$1")).QueryTable

.CommandType = xlCmdSql

.CommandText = Array("SELECT * FROM [BFR 02]")

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

.Refresh BackgroundQuery:=False

End With

Rechercher des sujets similaires à "erreur execution 1004 vba"