Erreur dans l'édition de QR Codes

Bonjour,

Dans le cadre professionnelle, je dois mettre en place des QR Codes pour plusieurs milliers d'équipements. J'ai trouvé le fichier ci-joint sur internet qui correspond parfaitement à mes besoins. Néanmoins, lorsque je génère les QR Codes pour mes milliers d'équipements, le fichier bug et j'ai un message d'erreur qui apparaît.

J'ai essayé de voir d'où venait le problème mais je n'ai pas trouvé la solution, pourriez-vous voir s'il vous plait ?

Avec par avance mes remerciements,

Cordialement,

Rahmane

Bonjour,

sur les 700 premiers (après...je n'ai pas essayé), pas de soucis chez moi; tu devrais peut être scinder ton fichier de données en plusieurs colonnes...

ça plante à combien d'enregistrements chez toi ?

P. (XL2007 / Win 10 24G de Ram)

Bonsoir,

Essaie ceci, et assure toi d'une bonne connexion. Et enregistre ton fichier en xlsm.

La barre d'état comporte un compteur (en bas à gauche de ton écran) pour suivre l'évolution de la procédure.

Cdlt.

Option Explicit

Private Sub creer_QRcode()
Dim wsData As Worksheet, WSNew As Worksheet
Dim Cell As Range, rngData As Range, rCell As Range
Dim shp As Shape
Dim sText As String
Dim lRows As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .DisplayStatusBar = True
    End With

    On Error Resume Next
    Worksheets("QRcodes").Delete
    On Error GoTo 0

    Application.DisplayAlerts = False

    Set wsData = ActiveSheet
    Set rngData = wsData.Cells(1).CurrentRegion
    lRows = rngData.Rows.Count

    Set WSNew = Worksheets.Add()
    WSNew.Name = "QRcodes"
    Set rCell = [A1]

    For Each Cell In rngData
        sText = Cell.Value
        Set shp = Nothing
        Application.StatusBar = Cell.Value & " sur " & lRows
        sText = "http://api.qrserver.com/v1/create-qr-code/?data=" & sText & "&size=250x250"
        '85, 85 indique la taille de la forme (1 pixel = 0.0353 cm donc 85 pixels = 3cm)
        Set shp = WSNew.Shapes.AddShape(msoShapeRectangle, rCell.Left, rCell.Top, 85, 85)
        With shp
            .Name = Cell
            .Line.Visible = False
            .Fill.UserPicture (sText)
        End With

        rCell.Offset(6, 0).Value = Cell.Value
        Set rCell = rCell.Offset(8, 0)
    Next

    Application.StatusBar = False

    Set rCell = Nothing
    Set shp = Nothing
    Set rngData = Nothing
    Set WSNew = Nothing: Set wsData = Nothing

End Sub

Bonjour à tous,

Patrick1957 : Mon fichier plantait après 100 équipements donc j'étais obligé de scinder pour pouvoir éditer mes QR Codes . Merci à toi de t'être penché sur le problème

Jean-Eric : C'est parfait, c'est exactement ce qu'il me fallait ! Merci beaucoup

Cordialement,

Rahmane