VBA EXCEL / Demande autorisation accès, Macro de recherche image qui demande l'autorisation d'accès

[Philippe_62]

Bonjour à tous,

J'ai créé une macro qui insère sur chaque ligne d'un fichier excel une image prise dans un dossier base image.
Le chemin d'accès est sur chaque ligne du fichier

Sauf que pour chaque fichier le finder me demande d'autoriser l'accès au dossier, puis au fichier.

Forcément c'est lourd car je dois boucler sur plus de 1000 fichiers.


J'ai essayé en déplaçant le dossier base image dans "Mes documents" et le résultat est le même.

Je suis sous Mac OS Catalina version 10.57

Voici mon code :

Code

Sub insert_img_lot2()


Dim t()

Dim Limg, Himg As Integer

Limg = Range("F1").Value
Himg = Range("H1").Value


Application.ScreenUpdating = False
With ActiveSheet
    dl = .Cells(.Rows.Count, "Y").End(xlUp).Row 'dernière ligne non vide en Y
    For i = 3 To dl 'de la ligne 3 à la dernière
        chemin = .Cells(i, "Y").Value 'chemin en Y
        ActiveCell.RowHeight = Limg
        
        ActiveCell.ColumnWidth = Himg
        
        
        If Dir(chemin) <> "" Then
            With .Cells(i, "Z") 'avec Z
                .RowHeight = Himg 'ajuste hauteur ligne
                imgLeft = .Left 'stocke position gauche de cellules
                imgTop = .Top 'stock position haute
                imgWidth = Limg 'larg col
                imgHeight = Himg 'haut lignes
            End With
            With .Shapes.AddPicture(chemin, msoFalse, msoTrue, imgLeft, imgTop, imgWidth, imgHeight) 'ajoute image (renvoie objet shape)
                .Name = Replace(chemin, ".jpg", "") & i 'modifie nom (sans ".jpg")
                .Placement = xlMoveAndSize 'pour vérouiller l'image à la cellule
            End With
        Else
            n = n + 1: ReDim Preserve t(1 To n): t(n) = chemin & " - ligne " & i
        End If
    Next i
    If n > 0 Then MsgBox "Images introuvables :" & vbCrLf & vbCrLf & Join(t, vbCrLf)
End With
Application.ScreenUpdating = True

End Sub

Mes deux questions :
- comment paramétrer le Finder pour ne pas avoir ces demandes ?
- si ce n'est pas possible quelles sont les commandes en VBA pour accorder l'accès ?

Merci pour votre aide


Philippe

Ce message a été modifié par baron - 25 Jun 2021, 13:09.

Raison de l'édition : Le code doit être placé entre les deux balises pour être mis en forme.

Fichier(s) joint(s)

 Capture_d___e__cran_2021_06_25_a___11.44.37.png ( 231.55 Ko ) Nombre de téléchargements : 0
 Capture_d___e__cran_2021_06_25_a___11.44.48.png ( 920.51 Ko ) Nombre de téléchargements : 0

 

[baron]

Bonjour et bienvenue !

Note de la modération : Ce message concerne une section différente de celle où tu as posté (OSX concerne uniquement le logiciel système et ses utilitaires).
Je déplace et t'invite à lire cette annonce.

(Ceci est un message automatique.)

[Aliboron]

- comment paramétrer le Finder pour ne pas avoir ces demandes ?

Ce n'est pas possible, les restrictions imposées par les récentes versions de macOS limitent l'accès direct par programmation aux fichiers.

- si ce n'est pas possible quelles sont les commandes en VBA pour accorder l'accès ?

Tu trouveras les indications voulues sur cette page, je pense.

[Philippe_62]

Merci !

Je teste cela.

A bientôt

[Philippe_62]

Bonjour,

J'ai modifié mon code et j'essaye d'utiliser la commande GrantaccesstoMultifiles mais en vain.

Voici mon nouveau code

CODE

Sub insert_img_excel()


Dim t()
Dim Limg, Himg As Integer
Dim fileAccessGranted As Boolean
Dim filePermissionCandidates

Limg = Range("F1").Value
Himg = Range("H1").Value


Application.ScreenUpdating = False
With ActiveSheet
dl = .Cells(.Rows.Count, "Y").End(xlUp).Row 'dernière ligne non vide en Y
For i = 3 To dl 'de la ligne 3 à la dernière
chemin = .Cells(i, "Y").Value 'chemin en Y

'Create an array with file paths for the permissions that are needed.
filePermissionCandidates = Array(chemin)

fileAccessGranted = GrantAccessToMultipleFiles(chemin)

ActiveCell.RowHeight = Limg
ActiveCell.ColumnWidth = Himg


If Dir(chemin) <> "" Then
With .Cells(i, "Z") 'avec Z
.RowHeight = Himg 'ajuste hauteur ligne
imgLeft = .Left 'stocke position gauche de cellules
imgTop = .Top 'stock position haute
imgWidth = Limg 'larg col
imgHeight = Himg 'haut lignes
End With
With .Shapes.AddPicture(chemin, msoFalse, msoTrue, imgLeft, imgTop, imgWidth, imgHeight) 'ajoute image (renvoie objet shape)
.Name = Replace(chemin, ".jpg", "") & i 'modifie nom (sans ".jpg")
.Placement = xlMoveAndSize 'pour vérouiller l'image à la cellule
End With
Else
n = n + 1: ReDim Preserve t(1 To n): t(n) = chemin & " - ligne " & i
End If
Next i
If n > 0 Then MsgBox "Images introuvables :" & vbCrLf & vbCrLf & Join(t, vbCrLf)
End With
Application.ScreenUpdating = True

End Sub

Qui peut m'aider ?

[Pat94]

Bonjour,

Avez vous essayé de mettre les images dans le dossier "Public" situé dans "Utilisateur".

[Aliboron]

Je ne comprends pas bien ta ligne fileAccessGranted = GrantAccessToMultipleFiles(chemin)

Logiquement, ça devrait plutôt être quelque chose comme fileAccessGranted = GrantAccessToMultipleFiles(filePermissionCandidates) sous réserve toutefois que ta table filePermissionCandidates soit correctement alimentée avec les chemins d'accès (à vérifier dans la fenêtre des "Variables locales" en mode arrêt).

Par ailleurs, cette ligne devrait être positionnée après le "next i" pour donner l'accès à tous les fichiers d'un coup.

Tu peux t'inspirer de l'exemple qu'on trouve sur cette page. La question de l'utilisateur concerne l'intégration Mac/Windows, mais la boucle pour l'autorisation d'accès est fonctionnelle...