Microsoft 365 QRCode dans cellule...

[WEIDER]

Bonjour à toutes et tous !

Je viens solliciter votre aide sur mon petit problème, j’ai bien retourné la chose dans tous les sens, mais mon (petit) niveau en Excel ne me permets hélas pas de le solutionner.

Tout est dit dans mon fichier joint !

D’avance un très très grand merci pour votre aide !

Belle journée à vous.

 

[natorp]

Bjr weider

Il n'y a rien en cellule H17, peut-être D17 ?
Sinon, est-ce que cette page peut vous aider ?

Comment créer un code QR basé sur la valeur de la cellule dans Excel?

fr.extendoffice.com

Cordialement, Gérard

 

[WEIDER]

Bonjour Natorp,

Merci pour ce lien, je vais voir ça...
N'étant pas administrateur de mon poste et n'ayant pas le Control 'Microsoft Barcode Control 16.0' dans ma trousse d'outil, installer des compléments à Excel va être compliquer...

 

[Orson83]

Bonjour natorp, WEIDER, le forum,

Il y a aussi cette application pour Excel 365.

QR4Office

https://appsource.microsoft.com/fr-fr/product/office/wa104051163?tab=overview

 

[Sequoyah]

Bonjour WEIDER et le Forum,

dans le module de ta feuille (pas dans un module standard) le code suivant,

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim BarcodeLink As String, BarcodePath As String, saveInFolder As String
    
    Application.ScreenUpdating = False
    
    If Not Intersect(Target, Range("D17")) Is Nothing Then
        If Range("D17").Value <> "" Then
            Call QRCodeToCell(Range("D17"), Range("F17"), 130, 130)
        End If
    End If
        
End Sub

'----------------------------
'Génère un QR code en cellule
'
'Arguments:
'---------
'- Chaine   : Chaine à encoder en QR Code
'- Cellule  : Cellule où placer l'image du QR Code
'- PicWidth : Largeur de l'image du QR Code
'- PicHeight: Hauteur de l'image du QR Code
'
'- Return   : Objet Picture de l'image du QR Code
'----------------------------
Function QRCodeToCell(Chaine As String, _
                      Cellule As Range, _
                      Optional PicWidth As Integer = 120, _
                      Optional PicHeight As Integer = 120) As Picture
                      
    Dim Link As String
    Dim Pic As Picture
    Dim PicName As String

    'https://developers.google.com/chart/infographics/docs/qr_codes
    Link = "http://chart.googleapis.com/chart?cht=qr&chs=" & PicWidth & "x" & PicHeight & "&chl=" & Chaine

    Windows(Cellule.Parent.Parent.Name).Activate
    Cellule.Parent.Activate
    Cellule.Activate
    PicName = "QRCode_" & Cellule.Address(0, 0)

    'Supprime une Shape de ce nom éventuellement présente
    For Each Pic In ActiveSheet.Pictures
        If Pic.Name = PicName Then Pic.Delete
    Next Pic

    'Génère l'image QR Code
    Set Pic = ActiveSheet.Pictures.Insert(Link)
    With Pic
    .Top = Cells(17, 6).Top - 15 '=====>> A' ADAPTER
    .Left = Cells(17, 6).Left + 70 '=====>> A' ADAPTER
    .Name = PicName
    
    End With
  '  Pic.Name = PicName
    Set QRCodeToCell = Pic
End Function

Cordialement

 

[Orson83]

Bonjour WEIDER et le Forum,

dans le module de ta feuille (pas dans un module standard) le code suivant,

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim BarcodeLink As String, BarcodePath As String, saveInFolder As String
   
    Application.ScreenUpdating = False
   
    If Not Intersect(Target, Range("D17")) Is Nothing Then
        If Range("D17").Value <> "" Then
            Call QRCodeToCell(Range("D17"), Range("F17"), 130, 130)
        End If
    End If
       
End Sub

'----------------------------
'Génère un QR code en cellule
'
'Arguments:
'---------
'- Chaine   : Chaine à encoder en QR Code
'- Cellule  : Cellule où placer l'image du QR Code
'- PicWidth : Largeur de l'image du QR Code
'- PicHeight: Hauteur de l'image du QR Code
'
'- Return   : Objet Picture de l'image du QR Code
'----------------------------
Function QRCodeToCell(Chaine As String, _
                      Cellule As Range, _
                      Optional PicWidth As Integer = 120, _
                      Optional PicHeight As Integer = 120) As Picture
                     
    Dim Link As String
    Dim Pic As Picture
    Dim PicName As String

    'https://developers.google.com/chart/infographics/docs/qr_codes
    Link = "http://chart.googleapis.com/chart?cht=qr&chs=" & PicWidth & "x" & PicHeight & "&chl=" & Chaine

    Windows(Cellule.Parent.Parent.Name).Activate
    Cellule.Parent.Activate
    Cellule.Activate
    PicName = "QRCode_" & Cellule.Address(0, 0)

    'Supprime une Shape de ce nom éventuellement présente
    For Each Pic In ActiveSheet.Pictures
        If Pic.Name = PicName Then Pic.Delete
    Next Pic

    'Génère l'image QR Code
    Set Pic = ActiveSheet.Pictures.Insert(Link)
    With Pic
    .Top = Cells(17, 6).Top - 15 '=====>> A' ADAPTER
    .Left = Cells(17, 6).Left + 70 '=====>> A' ADAPTER
    .Name = PicName
   
    End With
  '  Pic.Name = PicName
    Set QRCodeToCell = Pic
End Function

Cordialement

Bonjour sequoyah,
Je suis très intéressé par cette application QR Code.
Je l'ai testé sur mon Excel 2010 mais cela ne fonctionne pas (j'ai peut-être mal fait un truc ou ma version d'Excel en trop ancienne 🤔).
Pourrais-tu l'intégrer dans un fichier Excel ?
En te remerciant par avance 👍

 

[natorp]

Bjr le fil

Merci à Sequoyah
Chez moi ça fonctionne nickel, Excel 2021
Je joins le fichier

Cordialement, Gérard

 

[WEIDER]

Pffffouuuuuuu la c'est du lour !

Merci beaucoup Sequoyah pour tes lignes de code.
Pour info ça fonctionne sur mon fichier !

Belle journée à tous !

 

[Orson83]

Bjr le fil

Merci à Sequoyah
Chez moi ça fonctionne nickel, Excel 2021
Je joins le fichier

Cordialement, Gérard

Merci sequoyah & natorp 👍
Cela fonctionne aussi chez moi.
Bonne journée😉

 

[Orson83]

Si j'osais, afin de répondre à une autre problématique, serait-il possible de générer plusieurs QR Codes avec un seul bouton ?
J'ai préparé un modèle en PJ.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Pour plus de clarté, j'ai transféré ma demande dans ce Thread https://excel-downloads.com/threads/generer-plusieurs-qr-codes-avec-bouton.20072161/
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!