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...