XL 2016 "And" sur valeur numérique entière

Olic78124 à dit:

Une petite explication simple serait la bienvenue.

Cliquez pour agrandir...

Sub Envoi_avancement()


Dim Destinataire As String, Sujet As String

Dim AccuseReception As Boolean

Dim ETL(10) As String

Dim ETL_tab(10) As Boolean

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet



' Gestion des onglets dans le carnet de commande source

Dim Onglet(30)

Dim Liste_demandeur(30)

Dim Feuille As Worksheet

Dim it_dem As Integer, NomOnglet As Integer



Set principal = ActiveWorkbook

principal.Activate

ActiveWorkbook.Sheets("Admin").Activate



'Déclaration des variables

Dim MyOlapp As Object

Dim myItem

Dim olMailItem

Dim myRecipients

Dim myAttachments

Dim strHTML As String



it_dem = 0

i_tab1 = 2


' Ouverture du document initial

Workbooks.Open Filename:=Fichier

' SERIE DE BOUCLE PERMETTANT DE RECUPERER DES INFORMATIONS SUR DIFFERENTS ONGLETS

' Puis on "incrémente" une variable add_DE de la façon suivante
Workbooks("pj").Activate

ActiveWorkbook.Sheets(Onglet(NomOnglet)).Activate

If attrib <> Cells(j, 30).Value Then

add_DE = 1

End If

If Date_CS <> Cells(j, 40).Value Then

add_DE = add_DE + 2

End If

If UO_FR <> Cells(j, 41).Value Then

add_DE = add_DE + 4

End If

If UO_RO <> Cells(j, 42).Value Then

add_DE = add_DE + 8

End If

If Date_liv <> Cells(j, 43).Value Then

add_DE = add_DE + 16

End If

If Status_liv <> Cells(j, 54).Value Then

add_DE = add_DE + 32

End If

If Progress <> Cells(j, 55).Value Then

add_DE = add_DE + 64

End If

If Ref_liv <> Cells(j, 57).Value Then

add_DE = add_DE + 128

End If

If Date_delivery <> Cells(j, 58).Value Then

add_DE = add_DE + 256

End If

' Plusieurs lignes de code où add_DE n'est plus exploitée


If add_DE <> 0 Then

' Ajouter une nouvelle Feuille à la fin du Classeur et la nommer

principal.Activate

FeuilleExiste = False

For Each Feuille In Worksheets

If Feuille.Name = Demandeur Then

FeuilleExiste = True

End If

Next Feuille

' Ajour d'une feuille car FeuilleExiste est toujours False

If FeuilleExiste = False Then

Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Demandeur

ActiveWorkbook.Sheets(Demandeur).Activate

' Première partie du tableau / "Validation estimations"

Cells(1, 1) = "Request number"

Cells(1, 2) = "Project"

Cells(1, 3) = "Function"

Cells(1, 4) = "Attribution"

Cells(1, 5) = "Date of supplier quotation (jj/mm/aaaa)"

Cells(1, 6) = "Number of UO FR"

Cells(1, 7) = "Number of UO Nearshore"

' Date à mettre dans l'ordre RequestedExpected-Proposed-Convergence-

Cells(1, 8) = "Proposed Delivery Date (jj/mm/aaaa)"

Cells(1, 9) = "Requested Delivery Date (jj/mm/aaaa)"

Cells(1, 10) = "Expected Delivery Date (jj/mm/aaaa)"

' Seconde partie du tableau / "Advancement"

Cells(1, 11) = "Request number"

Cells(1, 12) = "Project"

Cells(1, 13) = "Function"

Cells(1, 14) = "Attribution"

Cells(1, 15) = "Status"

Cells(1, 16) = "Work Progress (%)"

Cells(1, 17) = "Deliverables references"

Cells(1, 18) = "Delivery Date (jj/mm/aaaa)"

Liste_demandeur(it_dem) = Demandeur

it_dem = it_dem + 1

End If


i_tab = Range("C1048576").End(xlUp).Row + 1



Cells(i_tab, 1) = Num_QIA

Cells(i_tab, 2) = projet

Cells(i_tab, 3) = Module

Cells(i_tab, 4) = attrib

Cells(i_tab, 5) = Date_CS

Cells(i_tab, 6) = UO_FR

Cells(i_tab, 7) = UO_RO

Cells(i_tab, 8) = Date_liv

Cells(i_tab, 9) = Req_Date

Cells(i_tab, 10) = Expect_Date

Cells(i_tab, 11) = Num_QIA

Cells(i_tab, 12) = projet

Cells(i_tab, 13) = Module

Cells(i_tab, 14) = attrib

Cells(i_tab, 15) = Status_liv

Cells(i_tab, 16) = Progress

Cells(i_tab, 17) = Ref_liv

Cells(i_tab, 18) = Date_delivery

Cells(i_tab, 19) = add_DE


End If



End If

Next j

NomOnglet = NomOnglet + 1

Wend


principal.Activate

For it_dem_fin = 0 To it_dem - 1

' On passe à la construction d'un mail, je vous épargne le code, aucune référence à add_DE

'Boucle mail

ActiveWorkbook.Sheets(Liste_demandeur(it_dem_fin)).Activate

' Création du corps de texte pour chaque interlocuteur

For liv = 2 To DernLigne_lble_env 'nombre de lignes (exemple plage A1:B5)

😡

strHTML = strHTML & "<TR halign='middle'nowrap>"

For j = 1 To 10 ' Nombre de colonnes

strHTML = strHTML & "<TD bgcolor='grey'align='center'><FONT COLOR='black'SIZE=3>" _

& Cells(liv, j) & "</FONT></TD>"

Next j

strHTML = strHTML & "</TR>"

End If

Next liv


' Code

For j = 11 To 18 ' Nombre de colonnes

strHTML = strHTML & "<TD bgcolor='blue'align='center'><FONT COLOR='white'SIZE=3>" _

& Cells(1, j) & "</FONT></TD>" ' Récupération des noms des colonnes pour mise en forme du tableau "Advancement"

Next j

DernLigne_lble_env = Range("A" & Rows.Count).End(xlUp).Row

For liv = 2 To DernLigne_lble_env 'nombre de lignes (exemple plage A1:B5)

If (Cells(liv, 19).Value And 32) = 32 Or (Cells(liv, 19).Value And 64) = 64 Or (Cells(liv, 19).Value And 128) = 128 Or (Cells(liv, 19).Value And 256) = 256 Then


strHTML = strHTML & "<TR halign='middle'nowrap>"

For j = 11 To 18 ' Nombre de colonnes

strHTML = strHTML & "<TD bgcolor='grey'align='center'><FONT COLOR='black'SIZE=3>" _

& Cells(liv, j) & "</FONT></TD>"

Next j

strHTML = strHTML & "</TR>"

End If

Next liv



' Récupération du mail du demandeur

Destinataire = ""

Dest = 2


While Not IsEmpty(Cells(Dest, 22).Value)

If Liste_demandeur(it_dem_fin) = Cells(Dest, 22).Value Then

Destinataire = Cells(Dest, 24).Value

End If

Dest = Dest + 1

Wend



' Si on ne trouve pas le mail du destinataire, il faut le créer

If Destinataire = "" Then

MsgBox "Le demandeur n'a pas été trouvé, merci de le créer"



NomUser = InputBox("Veuillez saisir Prénom Nom du demandeur :")

Cells(Dest, 23).Value = NomUser



NomUser = InputBox("Veuillez saisir l'identifiant du demandeur :")

Cells(Dest, 22).Value = NomUser



NomUser = InputBox("Veuillez saisir l'adresse mail du demandeur :")

Cells(Dest, 24).Value = NomUser

Destinataire = NomUser

End If



Set MyOlapp = CreateObject("Outlook.Application")

Set myItem = MyOlapp.CreateItem(olMailItem)

Set myRecipients = myItem.Recipients

' Destinataire pour les tests

myRecipients.Add ("A")

' Destinataires pour la production / A METTRE EN COMMENTAIRE PENDANT LES TESTS

' myRecipients.Add (Destinataire)

' myRecipients.Add ("B")

' myRecipients.Add (C")

' myRecipients.Add ("D")

Set myAttachments = myItem.Attachments

myItem.HTMLBody = strHTML

myItem.Subject = "[Updated request] Informations about your request"

' myItem.Send

Application.DisplayAlerts = False

ActiveWorkbook.Sheets(Liste_demandeur(it_dem_fin)).Delete

Application.DisplayAlerts = True

Next it_dem_fin

'xlBook.Save

'xlBook.Close

'Kill ("test.xls")

Workbooks.Item(old_version).Close

End Sub

Cliquez pour agrandir...

Staple1600 à dit:

Bonjour le fil

Olic78124
Tu aimes bien jouer avec le feu?
Ou tu veux tester la nouvelle mesure Pole Emploi pour les démissionnaires?
😱
Relis le pavé de code que tu as posté
Et supprimes vite ce que le RGPD aurait du t'inciter à ne pas publier... 🙄

Sinon pour ton questionnement, est-ce que ce petit code éclaire ta lanterne ?

VB:

Sub PetitTest()
Dim t, i As Byte, x
t = Array(64, 23, "=TODAY()", 32, "a")
[A1].Select
For i = 0 To 4
[A1] = t(i)
[A1].NumberFormatLocal = "Standard"
On Error GoTo e_rr:
x = [A1] And 32
MsgBox x & Chr(13) & (([A1] And 32) = 32) & Chr(13) & Range("A1").FormulaLocal
Next
e_rr:
MsgBox "Valeur non numérique", vbCritical
Exit Sub
End Sub

Cliquez pour agrandir...

eriiiic à dit:

Bonjour à tous,

il s'agit d'un masque.
Considère tes nombres écrits en binaire, le AND est fait bit à bit.
Le faire avec une puissance de 2 (un seul bit de positionné donc) revient à masquer tous les autres bits en les passant à 0 pour tester le bit voulu.
3=2 => 11 AND 10 >= 10 => 2 => VRAI
Le bit de poids 1 (numérotés à partir de 0 de droite à gauche) est positionné.

Ta ligne teste donc si un des bits 1 à 4 est positionné : 11110
J'aurais plutôt écris ta ligne ainsi

VB:

if (Cells(liv, 17) ).Value And 2) Or (Cells(liv, 17) .Value And 4)  Or (Cells(liv, 17) .Value And 8)  Or (Cells(liv, 17) .Value And 16) then

les =x sont inutiles et embrouillent la lecture et la compréhension.

Et tant qu'on y est autant grouper tous les bits testés. Vu que 11110=30 :

Code:

if Cells(liv, 17) .Value And 30 then

donne le même résultat

Disons qu'avec les tailles mémoire qu'on a aujourd'hui, stocker plusieurs infos dans un mot binaire est un peu daté mais ça peut avoir son utilité.
eric

Cliquez pour agrandir...