XL 2016 VBA PI DataLink : Probleme Application.Screenupdating avec procédure de MAJ plage

[safranien]

Bonjour à tous

je sollicite votre aide car je n'arrive pas à résoudre un problème avec un de mes codes. Dans le cadre de mon activité, j'utilise PI DataLink et ai rédigé un code qui me permet de mettre à jour les plages de données liées à PI.
Mon problème est qu'à chaque exécution du code, je vois le changement de feuille (de TDB à Datas, actualisation de splages puis retour à la feuille TDB) et ce, malgré Application.Screenupdating = False.
Je comprends que le problème vient des ".select" pour sélectionner la première cellule de la plage de données PI mais je ne sais pas comment ne pas les utiliser.

Ci-dessous mon code :

Sub Refresh()

Dim addIn As COMAddIn
Dim automationObject As Object

Dim wsDatas As Worksheet
Dim wsTDB As Worksheet

Dim MyRange1 As Range
Dim MyRange2 As Range

Set addIn = Application.COMAddIns("PI DataLink")
Set automationObject = addIn.Object

Set wsDatas = ThisWorkbook.Worksheets("DATAS")
Set wsTDB = ThisWorkbook.Worksheets("TDB")

Set MyRange1 = wsDatas.Range("R30")
Set MyRange2 = wsDatas.Range("T30")


Application.ScreenUpdating = False

    wsTDB.Range("P1").Calculate
    wsTDB.Range("P2").Calculate
    wsDatas.Range("A1:B2,C2:V2").Calculate
    wsTDB.Range("A11:B22").Calculate
    wsDatas.Range("B4:B16").Calculate
        
        If (Left(Worksheets("TDB").Range("P1"), 4) = "BT >") Then
        
        'Application.ScreenUpdating = False
        
                    
            With wsDatas
            .Select
                        
                With MyRange1
                .Select
  
                automationObject.SelectRange
                automationObject.ResizeRange
                
                End With
            
            
                With MyRange2
                .Select
  
                automationObject.SelectRange
                automationObject.ResizeRange
                
                End With
            
            End With
      
            wsTDB.Select
                  
        Else
        
        End If

        
    Application.Calculation = xlCalculationAutomatic
    Application.Calculation = xlCalculationManual
    

Application.ScreenUpdating = True

End Sub

Le problème vient donc de cette partie de code mais comme je le disais je ne sais pas comment ne pas utiliser les .Select des With MyRange1 etc

With wsDatas
            .Select
                        
                With MyRange1
                .Select
  
                automationObject.SelectRange
                automationObject.ResizeRange
                
                End With
            
            
                With MyRange2
                .Select
  
                automationObject.SelectRange
                automationObject.ResizeRange
                
                End With
            
            End With
      
            wsTDB.Select

En espérant que l'un de vous connaisse PI Data Link et puisse m'aider.

Bonne soirée

 

[Staple1600]

Bonsoir

Sans parler d'espoir, un lien déjà nous aurait éclairé...

PI DataLink - Overview

techsupport.osisoft.com

 

[Staple1600]

Re

En relisant ton code
Ceci devrait suffire
With MyRange1
...' le reste du code

Puisque tu as définis ta range au préalable

 

[Staple1600]

Re

Ce qui donnerait un truc du genre

Sub Refresh()
Dim addIn As COMAddIn
Dim automationObject As Object
Dim wsDatas As Worksheet
Dim wsTDB As Worksheet
Dim MyRange1 As Range
Dim MyRange2 As Range
Set addIn = Application.COMAddIns("PI DataLink")
Set automationObject = addIn.Object
Set wsDatas = ThisWorkbook.Worksheets("DATAS")
Set wsTDB = ThisWorkbook.Worksheets("TDB")
Set MyRange1 = wsDatas.Range("R30")
Set MyRange2 = wsDatas.Range("T30")
Application.ScreenUpdating = False
wsTDB.Range("P1").Calculate
wsTDB.Range("P2").Calculate
wsDatas.Range("A1:B2,C2:V2").Calculate
wsTDB.Range("A11:B22").Calculate
wsDatas.Range("B4:B16").Calculate
If (Left(Worksheets("TDB").Range("P1"), 4) = "BT >") Then
    With MyRange1
        automationObject.SelectRange
        automationObject.ResizeRange
        End With
    With MyRange2
        automationObject.SelectRange
        automationObject.ResizeRange
    End With
Else
'
End If
Application.Calculation = xlCalculationAutomatic
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
End Sub

A toi de tester 😉

 

[safranien]

Bonsoir Stapple1600

merci pour ta proposition que j'ai effectivement déjà essayée mais qui ne fonctionne pas. Bien qu'ayant défini mes MyRange au départ, si je supprime les .Select des MyRange et With wsDatas.Select, le code ne me trouve pas les cellules pour les actualiser, j'ai le message "Pas de cellules correspondantes".

 

[Staple1600]

Re

Et un truc du genre, cela produit quoi?

....
automationObject.MyRange1.ResizeRange
...

 

[safranien]

re

ca met met "erreur d'exécution 438 : propriété ou méthode non gérée par cet objet"
snif

 

[Staple1600]

Re

Combien coute cet addin?

 

[safranien]

Alors je n'en sais rien du tout. C'est une suite logicielle payée par mon entreprise.
J'essaie de trouver des forums pour trouver d'autres codes. Je dois en tester deux trouvés quand je reviendrai des courses 😁
Je tiens au courant.

 

[safranien]

bon, l'autre code trouvé est celui-ci que j'appelle dans ma procédure Refresh à la place de toute la partie de code avec les MyRange

Sub ResizeAll()
    Dim addIn As COMAddIn
    Dim automationObject As Object
    Set addIn = Application.COMAddIns("PI DataLink")
    Set automationObject = addIn.Object
    'To adjust this subroutine to another Excel worksheet, update the cell references in allRanges to reflect the top left cell of each DataLink array.
    'Then change the array size in the below line:
    Dim allRanges(1 To 2) As Range
    Dim i As Long
 
    'Set the values of the allRanges array to the top left cell of each DataLink result array.
    Set allRanges(1) = Sheets("DATAS").Range("R30")
    Set allRanges(2) = Sheets("DATAS").Range("T30")
'    Set allRanges(3) = Range("E21")
'    Set allRanges(4) = Range("M2")
'    Set allRanges(5) = Range("P2")
'    Set allRanges(6) = Range("R2")
'    Set allRanges(7) = Range("V2")
    
    For i = LBound(allRanges) To UBound(allRanges)
        'For each DataLink array, select the top left cell, then select all cells in the array, and finally resize the array.
        allRanges(i).Select
        automationObject.SelectRange
        automationObject.ResizeRange
    Next i
End Sub

mais ça me provoque une erreur "Erreur s'exécution 1004 : La méthode Select de la classe Range a échoué" en me surlignant allRanges(i).Select

 

[Staple1600]

RE

Essaies de mettre ceci en début de module
Option Base 1

NB: Conseil en passant
Cites tes sources
On peut parfois y trouver des explications complémentaires utiles

Multiple array resize at same time - Forum - PI Square - AVEVA Community

Hi, I have a spreadsheet that on "auto open" resizes arrays through the dlresize function. There are about 9 separate arrays that resize. During the open sequence

pisquare.osisoft.com

 

[safranien]

d'accord, je citerai pour les prochaines fois.
J'ai ajouté Option Base 1 en début de module (avec Option Explicit et Option Private Module déjà présents) et ça ne change rien, je vois toujours le changement de feuille.

 

[Staple1600]

Re

Normalement classiquement dans Excel on utilise l'Array ainsi
Cela donne quoi ainsi ,

Option Base 1
Sub ResizeAll()
    Dim addIn As COMAddIn
    Dim automationObject As Object
    Set addIn = Application.COMAddIns("PI DataLink")
    Set automationObject = addIn.Object
    'To adjust this subroutine to another Excel worksheet, update the cell references in allRanges to reflect the top left cell of each DataLink array.
    'Then change the array size in the below line:
    Dim allRanges(2)
    Dim i As Long
    'Set the values of the allRanges array to the top left cell of each DataLink result array.
    allRanges(1) = Sheets("DATAS").Range("R30").Address
    allRanges(2) = Sheets("DATAS").Range("T30").Address
    For i = LBound(allRanges) To UBound(allRanges)
        'For each DataLink array, select the top left cell, then select all cells in the array, and finally resize the array.
        Sheets("DATAS").Range(allRanges(i)).Select
        automationObject.SelectRange
        automationObject.ResizeRange
    Next i
End Sub

 

[safranien]

Merci Stapple1600 pour le temps que tu consacres à mon problème
j'ai tenté ton code mais même résultat que précédemment

 

[Staple1600]

Re

Pourtant ce test de boucle fonctionne

Option Base 1
Sub ResizeAll_test()
   ' Dim addIn As COMAddIn
    'Dim automationObject As Object
    'Set addIn = Application.COMAddIns("PI DataLink")
   ' Set automationObject = addIn.Object
    'To adjust this subroutine to another Excel worksheet, update the cell references in allRanges to reflect the top left cell of each DataLink array.
    'Then change the array size in the below line:
    Dim allRanges(2)
    Dim i As Long
    'Set the values of the allRanges array to the top left cell of each DataLink result array.
    allRanges(1) = Sheets("DATAS").Range("R30").Address
    allRanges(2) = Sheets("DATAS").Range("T30").Address
    For i = LBound(allRanges) To UBound(allRanges)
        'For each DataLink array, select the top left cell, then select all cells in the array, and finally resize the array.
       MsgBox Sheets("DATAS").Range(allRanges(i)).Address 'Select
       ' automationObject.SelectRange
        'automationObject.ResizeRange
    Next i
End Sub

Mais bon sans disposer de l'addin, difficile de tester in situ.