Bonjour,
J'ai récupéré un fichier excel, qui génère des QR code en ligne, à partir des données présentes dans tout le document. Ce que je souhaite c'est que cette sélection s'effectue sur une colonne.
Je pense que la ligne a modifier est gras, cependant après plusieurs recherches et de tests avec Range, Cell, colums select, j'ai toujours une erreur. Si quelqu'un peut m'aiguiller, je suis preneur.
voici le code :
Function Feuille_existe(Feuille_nom As String) As Boolean
' Retourne VRAI si la feuille existe dans le classeur actif
Feuille_existe = False
On Error GoTo erreur
If Len(Sheets(Feuille_nom).Name) > 0 Then
Feuille_existe = True
Exit Function
End If
erreur:
End Function
Sub creer_QRcode()
Dim enregistrement As Range
Dim donnee As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sel = Selection.SpecialCells(xlTextValues) 'sélectionne toutes les données de la feuille
If Feuille_existe("QRcodes") Then
Worksheets("QRcodes").Delete 'efface la feuille QRcodes si elle existe
End If
Set newfeuille = Worksheets.Add()
newfeuille.Name = "QRcodes"
Set cellule = newfeuille.Range("A1")
For Each enregistrement In sel
donnee = enregistrement.Value
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & donnee & "&size=250x250"
'donnee = "http://api.qrserver.com/v1/create-qr-code/?data=BEGIN%3AVCARD%0AFN%3Aprenom%20Nom%0ATEL%3Atelephone%0AEMAIL%3ACourriel%0AURL%3Ahttp%3A%2F%2Fsiteweb.fr%0AN%3ANom%3Bprenom%0AADR%3Arue%3Bcodepostal%3BVille%0AVERSION%3A3.0%0AEND%3AVCARD%0A&size=315x315"
Set newforme = newfeuille.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 15, 15) 15, 15 indique la taille de la forme
'1 pixel = 0.0353 cm )
newforme.Name = enregistrement 'nomme l'image en fonction de l'url
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Set cellule = cellule.Offset(0, 0).Range("B1")
cellule.Value = enregistrement.Value
Set cellule = cellule.Offset(1, -1).Range("A1")
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'
End Sub
J'ai récupéré un fichier excel, qui génère des QR code en ligne, à partir des données présentes dans tout le document. Ce que je souhaite c'est que cette sélection s'effectue sur une colonne.
Je pense que la ligne a modifier est gras, cependant après plusieurs recherches et de tests avec Range, Cell, colums select, j'ai toujours une erreur. Si quelqu'un peut m'aiguiller, je suis preneur.
voici le code :
Function Feuille_existe(Feuille_nom As String) As Boolean
' Retourne VRAI si la feuille existe dans le classeur actif
Feuille_existe = False
On Error GoTo erreur
If Len(Sheets(Feuille_nom).Name) > 0 Then
Feuille_existe = True
Exit Function
End If
erreur:
End Function
Sub creer_QRcode()
Dim enregistrement As Range
Dim donnee As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sel = Selection.SpecialCells(xlTextValues) 'sélectionne toutes les données de la feuille
If Feuille_existe("QRcodes") Then
Worksheets("QRcodes").Delete 'efface la feuille QRcodes si elle existe
End If
Set newfeuille = Worksheets.Add()
newfeuille.Name = "QRcodes"
Set cellule = newfeuille.Range("A1")
For Each enregistrement In sel
donnee = enregistrement.Value
donnee = "http://api.qrserver.com/v1/create-qr-code/?data=" & donnee & "&size=250x250"
'donnee = "http://api.qrserver.com/v1/create-qr-code/?data=BEGIN%3AVCARD%0AFN%3Aprenom%20Nom%0ATEL%3Atelephone%0AEMAIL%3ACourriel%0AURL%3Ahttp%3A%2F%2Fsiteweb.fr%0AN%3ANom%3Bprenom%0AADR%3Arue%3Bcodepostal%3BVille%0AVERSION%3A3.0%0AEND%3AVCARD%0A&size=315x315"
Set newforme = newfeuille.Shapes.AddShape(msoShapeRectangle, cellule.Left, cellule.Top, 15, 15) 15, 15 indique la taille de la forme
'1 pixel = 0.0353 cm )
newforme.Name = enregistrement 'nomme l'image en fonction de l'url
newforme.Line.Visible = False 'enlève la ligne de contour
newforme.Fill.UserPicture (donnee) 'insère l'image dans la forme
Set cellule = cellule.Offset(0, 0).Range("B1")
cellule.Value = enregistrement.Value
Set cellule = cellule.Offset(1, -1).Range("A1")
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'
End Sub