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

 

[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 ?