Création d'une DLL VB pour Excel

Bonsoir Robert
Expliquez moi une chose
si j'ai déjà mes macros en vba qui fonctionnent bien pour mon classeur excel, et que je veux couper les macros et les coller dans vb6 afin d'en faire un dll :
comment je m'y prend ?
comment je réorganise mes macros une fois dans vb6 ?
comment j'organise une macro excel afin d'appeler le dll créé ?:calim2:

Un exemple de calcul de somme pourait déjà m'aider.
Un grand merci à l'avance :(:(

Bonsoir,
ce qu'il faut bien intégrer, c'est que Vb6 permet énormément beaucoup plus de possibilités que Vba!

Vba en revanche dispose en natif les objets Excel!

Vb6 permet d’identifier les objets Excel via les références, mais dans ce cas ta DLL sera dédié à la version Excel installé sur la machine de développement!

on ne développera pas une DLL pour gérer les interface , dans ce cas autant tout développer en VB6 et compiler un exécutable.exe.


nous déplacerons les méthode de notre programme vers des module de classe de notre DLL!

avant d'encoder notre DLL, nous la développerons dans EXCEL!

note que les déclaration du type dim Wb as workbook ne ce ferra pas dans VB6 mais dans VBA et nous fournirons WB à notre DLL sous forme d'objet.

ton travail consistera à placer toutes tes méthode dans un module de classe!

nous commencerons par générer notre module de classe dans VBA en prenant bien soin de ne pas utiliser des objets EXCEL!

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Private Ws As Object Public Property Let Feuille(value As Object) Set Ws = value End Property     Public Function Feuil() Feuil = Ws.Name End Function Public Function Tableau(Classeur As Object) Dim I As Integer, T() As String For I = 1 To Classeur.Sheets.Count ReDim Preserve T(I): T(I) = Classeur.Sheets(I).Name Next Tableau = T End Function

---

Code:

---

1 2 3 4 5 6 7 8 9

Sub Test() Dim T As New Classe1 T.Feuille = ThisWorkbook.Sheets(1) MsgBox T.Feuil TB = T.Tableau(ThisWorkbook) For I = 1 To UBound(TB) MsgBox TB(I) Next End Sub

---

c'est seulement après ce transfère de code dans un module de classe VBA que tu pourras envisager de coder ta DLL!

Bonjour.
j'ai un petit soucis
Peux tu faire un calcul simple en faisant intervenir trois cellules situées sur trois feuilles différentes??
Genre feuil1.range(a1) = feuil2.range(a2) * feuil3.range(a3)
En guise d'exemple, ça me permettra de bien comprendre l'affaire des dll.

Merci d'avance

Bonsoir?

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Public Sub CalculSurTroisFeuilles(ByRef Val1 As Object, Val2 As Object, Operateur As String, Val3 As Object) If Not IsNumeric(Val2.Value) Then Err.Raise 15, "CalculSurTroisFeuilles", "Val2.Value " & Val2.Value & n 'est pas un numerique" If Not IsNumeric(Val3.Value) Then Err.Raise 15, "CalculSurTroisFeuilles", "Val3.Value " & Val3.Value & n 'est pas un numerique" Val1 = calcul(Val2, Operateur, Val3) End Sub Private Function calcul(Val1 As Object, Operateur As String, Val2 As Object) As Double Select Case Operateur Case "+": calcul = Val1 + Val2 Case "-": calcul = Val1 - Val2 Case "*": calcul = Val1 * Val2 Case "/": calcul = Val1 / Val2 Case Else: Err.Raise 10, "CalculSurTroisFeuilles", "incohérence d'opérateur " & Operateur End Select End Function

---

Code:

---

1 2 3 4 5 6 7

Sub test()Dim clcl As New Classe1 Range("Feuil2!A1") = 10: Range("Feuil3!A1") = 15 clcl.CalculSurTroisFeuilles Range("Feuil1!A1"), Range("Feuil2!A1"), "*", Range("Feuil3!A1") clcl.CalculSurTroisFeuilles Range("Feuil1!A1"), Range("Feuil2!A1"), "?", Range("Feuil3!A1") Range("Feuil2!A1") = "TOTO" clcl.CalculSurTroisFeuilles Range("Feuil1!A1"), Range("Feuil2!A1"), "/", Range("Feuil3!A1") End Sub

---

Code:

---

1 2 3 4 5

Public Sub CalculSurTroisFeuillesBis(ByRef Wb As Object) If Not IsNumeric(wb.sheets("feuil2").range("A1")) Then Err.Raise 15, "CalculSurTroisFeuilles", " n 'est pas un numerique" If Not IsNumeric(wb.sheets("feuil3").range("A1")) Then Err.Raise 15, "CalculSurTroisFeuilles", n 'est pas un numerique" Wb.sheets("feuil1").range("A1") = calcul(wb.sheets("feuil2").range("A1"), "*", wb.sheets("feuil3").range("A1")) End Sub

---

Grand merci a toi. je comprend mieux. merci :D

Bonsoir
je reviens encore et encore finalement.
J'ai bien réussi a faire le dll qui fonctionne bien.
Mais lorsque je colle les module de "vérification de licence" que tu as créés dans VB6, j'ai des lignes en rouge
notamment les lignes avec Ptrsafe (refusant le ptrsafe), et celles avec Public const (refusant le "Public" qui précède "const")
Alors que tout ceci marche bien en VBA. (Pas de lignes en rouge).
il y a t-il une solution pour ça.?

Bonsoir,

La déclaration des api (Ptrsafe) c'est pour du 64 bits!
Par définition Vb6 c'est du 32 bits! En plus dans le module dont tu parle il y a des directives de compilation (#if then)!

Mais Vbs n'en a pas besoin car la dll c'est un code compilé!

Je regarde car en plus Vb6 dispose d'instructions pour dialoguer avec la base de registre!

Bonjour,

Code:

---

Global Const Produit = "1DA242EAF2A6EAF11937EE18311CD2FD"

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

Private Function ReadRegistre(Path As String, Section As String, Key As String, Default) On Error Resume Next ReadRegistre = GetSetting(Path, Section, Key, Default) If Err Then ReadRegistre = "" Err.Clear: On Error GoTo 0 End Function Private Function WriteRegistre(Path As String, Section As String, Key As String, Setting As String) As Boolean On Error Resume Next SaveSetting Path, Section, Key, Setting WriteRegistre = Not CBool(Err.Number) Err.Clear: On Error GoTo 0 End Function Private Function SupprimerRegistre(Path As String, Section As String, Key As String) As Boolean On Error Resume Next DeleteSetting Path, Section, Key SupprimerRegistre = Not CBool(Err.Number) Err.Clear: On Error GoTo 0 End Function     Private Sub VerifLicence() Dim md5Test As New MD5, CodeProduit As String, Licence As String CodeProduit = ReadRegistre("SOFTWARE", "KEY_LOCAL_MICROSOT\" & Produit, "Produit", "") If Trim(CodeProduit) = "" Then CodeProduit = md5Test.DigestStrToHexStr(Environ("COMPUTERNAME") & Produit & DisckSerial) WriteRegistre "SOFTWARE", "KEY_LOCAL_MICROSOT\" & Produit, "Produit", CStr(CodeProduit) WriteRegistre "SOFTWARE", "KEY_LOCAL_MICROSOT\" & Produit, CStr(CodeProduit), "" Else If Trim(CodeProduit) <> md5Test.DigestStrToHexStr(Environ("COMPUTERNAME") & Produit & DisckSerial) Then Err.Raise 100, "Licence", "N° de Produit non valide!" End If End If Licence =ReadRegistre("SOFTWARE", "KEY_LOCAL_MICROSOT\" & Produit, CStr(CodeProduit), "") If Licence <> creerLicence(CodeProduit) Then WriteRegistre "SOFTWARE", "KEY_LOCAL_MICROSOT\" & Produit, CStr(CodeProduit), InputBox("Code Produit : " & CodeProduit & vbCrLf & "Entrez le N° de licence :" & vbCrLf & "Ou contactez votre agence commerciale.", "Gestionnaire de licence :") End If If Licence <> creerLicence(CodeProduit) Then Err.Raise 105, "Licence", "N° de licence non valide!" End If End Sub Private Function creerLicence(CodeProduit) Dim md5Test As New MD5 creerLicence = "" If Trim("" & CodeProduit) = "" Then Exit Function creerLicence = md5Test.DigestStrToHexStr("1DA242EAF2A6EAF11937EE18311CD2FD" & Trim("" & CodeProduit)) End Function Private Function DisckSerial() As String On Error Resume Next Set List = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_LogicalDisk") For Each Object In List DisckSerial = DisckSerial & Object.VolumeSerialNumber Next End Function Private Sub Class_Initialize() VerifLicence End Sub Private Function calcul(Val1 As Object, Operateur As String, Val2 As Object) As Double Select Case Operateur Case "+": calcul = Val1 + Val2 Case "-": calcul = Val1 - Val2 Case "*": calcul = Val1 * Val2 Case "/": calcul = Val1 / Val2 Case Else: Err.Raise 10, "CalculSurTroisFeuilles", "incohérence d'opérateur " & Operateur End Select End Function Public Sub CalculSurTroisFeuilles(ByRef Wb As Object) If Not IsNumeric(Wb.sheets("feuil2").range("A1")) Then Err.Raise 15, "CalculSurTroisFeuilles", " n 'est pas un numerique" If Not IsNumeric(Wb.sheets("feuil3").range("A1")) Then Err.Raise 15, "CalculSurTroisFeuilles", n 'est pas un numerique" Wb.sheets("feuil1").range("A1") = calcul(Wb.sheets("feuil2").range("A1"), "*", Wb.sheets("feuil3").range("A1")) End Sub

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604

Option Explicit   '/****************************************************************************** ' * Copyright (C) 2000 by Robert Hubley. * ' * All rights reserved. * ' * * ' * This software is provided ``AS IS'' and any express or implied * ' * warranties, including, but not limited to, the implied warranties of * ' * merchantability and fitness for a particular purpose, are disclaimed. * ' * In no event shall the authors be liable for any direct, indirect, * ' * incidental, special, exemplary, or consequential damages (including, but * ' * not limited to, procurement of substitute goods or services; loss of use, * ' * data, or profits; or business interruption) however caused and on any * ' * theory of liability, whether in contract, strict liability, or tort * ' * (including negligence or otherwise) arising in any way out of the use of * ' * this software, even if advised of the possibility of such damage. * ' * * ' ****************************************************************************** ' ' CLASS: MD5 ' ' DESCRIPTION: ' This is a class which encapsulates a set of MD5 Message Digest functions. ' MD5 algorithm produces a 128 bit digital fingerprint (signature) from an ' dataset of arbitrary length. For details see RFC 1321 (summarized below). ' This implementation is derived from the RSA Data Security, Inc. MD5 Message-Digest ' algorithm reference implementation (originally written in C) ' ' AUTHOR: ' Robert M. Hubley 12/1999 ' ' ' NOTES: ' Network Working Group R. Rivest ' Request for Comments: 1321 MIT Laboratory for Computer Science ' and RSA Data Security, Inc. ' April 1992 ' ' ' The MD5 Message-Digest Algorithm ' ' Summary ' ' This document describes the MD5 message-digest algorithm. The ' algorithm takes as input a message of arbitrary length and produces ' as output a 128-bit "fingerprint" or "message digest" of the input. ' It is conjectured that it is computationally infeasible to produce ' two messages having the same message digest, or to produce any ' message having a given prespecified target message digest. The MD5 ' algorithm is intended for digital signature applications, where a ' large file must be "compressed" in a secure manner before being ' encrypted with a private (secret) key under a public-key cryptosystem ' such as RSA. ' ' The MD5 algorithm is designed to be quite fast on 32-bit machines. In ' addition, the MD5 algorithm does not require any large substitution ' tables; the algorithm can be coded quite compactly. ' ' The MD5 algorithm is an extension of the MD4 message-digest algorithm ' 1,2]. MD5 is slightly slower than MD4, but is more "conservative" in ' design. MD5 was designed because it was felt that MD4 was perhaps ' being adopted for use more quickly than justified by the existing ' critical review; because MD4 was designed to be exceptionally fast, ' it is "at the edge" in terms of risking successful cryptanalytic ' attack. MD5 backs off a bit, giving up a little in speed for a much ' greater likelihood of ultimate security. It incorporates some ' suggestions made by various reviewers, and contains additional ' optimizations. The MD5 algorithm is being placed in the public domain ' for review and possible adoption as a standard. ' ' RFC Author: ' Ronald L.Rivest ' Massachusetts Institute of Technology ' Laboratory for Computer Science ' NE43 -324545 Technology Square ' Cambridge, MA 02139-1986 ' Phone: (617) 253-5880 ' EMail: Rivest@ theory.lcs.mit.edu ' ' ' ' CHANGE HISTORY: ' ' 0.1.0 RMH 1999/12/29 Original version ' '         '= '= Class Constants '= Private Const OFFSET_4 = 4294967296# Private Const MAXINT_4 = 2147483647     Private Const S11 = 7 Private Const S12 = 12 Private Const S13 = 17 Private Const S14 = 22 Private Const S21 = 5 Private Const S22 = 9 Private Const S23 = 14 Private Const S24 = 20 Private Const S31 = 4 Private Const S32 = 11 Private Const S33 = 16 Private Const S34 = 23 Private Const S41 = 6 Private Const S42 = 10 Private Const S43 = 15 Private Const S44 = 21         '= '= Class Variables '= Private State(4) As Long Private ByteCounter As Long Private ByteBuffer(63) As Byte         '= '= Class Properties '= Property Get RegisterA() As String RegisterA = State(1) End Property     Property Get RegisterB() As String RegisterB = State(2) End Property     Property Get RegisterC() As String RegisterC = State(3) End Property     Property Get RegisterD() As String RegisterD = State(4) End Property         '= '= Class Functions '=     ' ' Function to quickly digest a file into a hex string ' Public Function DigestFileToHexStr(FileName As String) As String Open FileName For Binary Access Read As #1 MD5Init Do While Not EOF(1) Get #1, , ByteBuffer If Loc(1) < LOF(1) Then ByteCounter = ByteCounter + 64 MD5Transform ByteBuffer End If Loop ByteCounter = ByteCounter + (LOF(1) Mod 64) Close #1 MD5Final DigestFileToHexStr = GetValues End Function     ' ' Function to digest a text string and output the result as a string ' of hexadecimal characters. ' Public Function DigestStrToHexStr(SourceString As String) As String MD5Init MD5Update Len(SourceString), StringToArray(SourceString) MD5Final DigestStrToHexStr = GetValues End Function     ' ' A utility function which converts a string into an array of ' bytes. ' Private Function StringToArray(InString As String) As Byte() Dim i As Integer Dim bytBuffer() As Byte ReDim bytBuffer(Len(InString)) For i = 0 To Len(InString) - 1 bytBuffer(i) = Asc(Mid(InString, i + 1, 1)) Next i StringToArray = bytBuffer End Function     ' ' Concatenate the four state vaules into one string ' Public Function GetValues() As String GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4)) End Function     ' ' Convert a Long to a Hex string ' Private Function LongToString(Num As Long) As String Dim a As Byte Dim b As Byte Dim c As Byte Dim d As Byte   a = Num And &HFF& If a < 16 Then LongToString = "0" & Hex(a) Else LongToString = Hex(a) End If   b = (Num And &HFF00&) \ 256 If b < 16 Then LongToString = LongToString & "0" & Hex(b) Else LongToString = LongToString & Hex(b) End If   c = (Num And &HFF0000) \ 65536 If c < 16 Then LongToString = LongToString & "0" & Hex(c) Else LongToString = LongToString & Hex(c) End If   If Num < 0 Then d = ((Num And &H7F000000) \ 16777216) Or &H80& Else d = (Num And &HFF000000) \ 16777216 End If   If d < 16 Then LongToString = LongToString & "0" & Hex(d) Else LongToString = LongToString & Hex(d) End If   End Function     ' ' Initialize the class ' This must be called before a digest calculation is started ' Public Sub MD5Init() ByteCounter = 0 State(1) = UnsignedToLong(1732584193#) State(2) = UnsignedToLong(4023233417#) State(3) = UnsignedToLong(2562383102#) State(4) = UnsignedToLong(271733878#) End Sub     ' ' MD5 Final ' Public Sub MD5Final() Dim dblBits As Double   Dim padding(72) As Byte Dim lngBytesBuffered As Long   padding(0) = &H80   dblBits = ByteCounter * 8   ' Pad out lngBytesBuffered = ByteCounter Mod 64 If lngBytesBuffered <= 56 Then MD5Update 56 - lngBytesBuffered, padding Else MD5Update 120 - ByteCounter, padding End If     padding(0) = UnsignedToLong(dblBits) And &HFF& padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF& padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF& padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF& padding(4) = 0 padding(5) = 0 padding(6) = 0 padding(7) = 0   MD5Update 8, padding End Sub     ' ' Break up input stream into 64 byte chunks ' Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte) Dim II As Integer Dim i As Integer Dim J As Integer Dim K As Integer Dim lngBufferedBytes As Long Dim lngBufferRemaining As Long Dim lngRem As Long   lngBufferedBytes = ByteCounter Mod 64 lngBufferRemaining = 64 - lngBufferedBytes ByteCounter = ByteCounter + InputLen ' Use up old buffer results first If InputLen >= lngBufferRemaining Then For II = 0 To lngBufferRemaining - 1 ByteBuffer(lngBufferedBytes + II) = InputBuffer(II) Next II MD5Transform ByteBuffer   lngRem = (InputLen) Mod 64 ' The transfer is a multiple of 64 lets do some transformations For i = lngBufferRemaining To InputLen - II - lngRem Step 64 For J = 0 To 63 ByteBuffer(J) = InputBuffer(i + J) Next J MD5Transform ByteBuffer Next i lngBufferedBytes = 0 Else i = 0 End If   ' Buffer any remaining input For K = 0 To InputLen - i - 1 ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K) Next K   End Sub     ' ' MD5 Transform ' Private Sub MD5Transform(Buffer() As Byte) Dim x(16) As Long Dim a As Long Dim b As Long Dim c As Long Dim d As Long   a = State(1) b = State(2) c = State(3) d = State(4)   Decode 64, x, Buffer     ' Round 1 FF a, b, c, d, x(0), S11, -680876936 FF d, a, b, c, x(1), S12, -389564586 FF c, d, a, b, x(2), S13, 606105819 FF b, c, d, a, x(3), S14, -1044525330 FF a, b, c, d, x(4), S11, -176418897 FF d, a, b, c, x(5), S12, 1200080426 FF c, d, a, b, x(6), S13, -1473231341 FF b, c, d, a, x(7), S14, -45705983 FF a, b, c, d, x(8), S11, 1770035416 FF d, a, b, c, x(9), S12, -1958414417 FF c, d, a, b, x(10), S13, -42063 FF b, c, d, a, x(11), S14, -1990404162 FF a, b, c, d, x(12), S11, 1804603682 FF d, a, b, c, x(13), S12, -40341101 FF c, d, a, b, x(14), S13, -1502002290 FF b, c, d, a, x(15), S14, 1236535329   ' Round 2 GG a, b, c, d, x(1), S21, -165796510 GG d, a, b, c, x(6), S22, -1069501632 GG c, d, a, b, x(11), S23, 643717713 GG b, c, d, a, x(0), S24, -373897302 GG a, b, c, d, x(5), S21, -701558691 GG d, a, b, c, x(10), S22, 38016083 GG c, d, a, b, x(15), S23, -660478335 GG b, c, d, a, x(4), S24, -405537848 GG a, b, c, d, x(9), S21, 568446438 GG d, a, b, c, x(14), S22, -1019803690 GG c, d, a, b, x(3), S23, -187363961 GG b, c, d, a, x(8), S24, 1163531501 GG a, b, c, d, x(13), S21, -1444681467 GG d, a, b, c, x(2), S22, -51403784 GG c, d, a, b, x(7), S23, 1735328473 GG b, c, d, a, x(12), S24, -1926607734   ' Round 3 HH a, b, c, d, x(5), S31, -378558 HH d, a, b, c, x(8), S32, -2022574463 HH c, d, a, b, x(11), S33, 1839030562 HH b, c, d, a, x(14), S34, -35309556 HH a, b, c, d, x(1), S31, -1530992060 HH d, a, b, c, x(4), S32, 1272893353 HH c, d, a, b, x(7), S33, -155497632 HH b, c, d, a, x(10), S34, -1094730640 HH a, b, c, d, x(13), S31, 681279174 HH d, a, b, c, x(0), S32, -358537222 HH c, d, a, b, x(3), S33, -722521979 HH b, c, d, a, x(6), S34, 76029189 HH a, b, c, d, x(9), S31, -640364487 HH d, a, b, c, x(12), S32, -421815835 HH c, d, a, b, x(15), S33, 530742520 HH b, c, d, a, x(2), S34, -995338651   ' Round 4 II a, b, c, d, x(0), S41, -198630844 II d, a, b, c, x(7), S42, 1126891415 II c, d, a, b, x(14), S43, -1416354905 II b, c, d, a, x(5), S44, -57434055 II a, b, c, d, x(12), S41, 1700485571 II d, a, b, c, x(3), S42, -1894986606 II c, d, a, b, x(10), S43, -1051523 II b, c, d, a, x(1), S44, -2054922799 II a, b, c, d, x(8), S41, 1873313359 II d, a, b, c, x(15), S42, -30611744 II c, d, a, b, x(6), S43, -1560198380 II b, c, d, a, x(13), S44, 1309151649 II a, b, c, d, x(4), S41, -145523070 II d, a, b, c, x(11), S42, -1120210379 II c, d, a, b, x(2), S43, 718787259 II b, c, d, a, x(9), S44, -343485551     State(1) = LongOverflowAdd(State(1), a) State(2) = LongOverflowAdd(State(2), b) State(3) = LongOverflowAdd(State(3), c) State(4) = LongOverflowAdd(State(4), d)     ' /* Zeroize sensitive information. '*/ ' MD5_memset ((POINTER)x, 0, sizeof (x));   End Sub     Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte) Dim intDblIndex As Integer Dim intByteIndex As Integer Dim dblSum As Double   intDblIndex = 0 For intByteIndex = 0 To Length - 1 Step 4 dblSum = InputBuffer(intByteIndex) + _ InputBuffer(intByteIndex + 1) * 256# + _ InputBuffer(intByteIndex + 2) * 65536# + _ InputBuffer(intByteIndex + 3) * 16777216# OutputBuffer(intDblIndex) = UnsignedToLong(dblSum) intDblIndex = intDblIndex + 1 Next intByteIndex End Sub     ' ' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4. ' Rotation is separate from addition to prevent recomputation. ' Private Function FF(a As Long, _ b As Long, _ c As Long, _ d As Long, _ x As Long, _ s As Long, _ ac As Long) As Long a = LongOverflowAdd4(a, (b And c) Or (Not (b) And d), x, ac) a = LongLeftRotate(a, s) a = LongOverflowAdd(a, b) End Function     Private Function GG(a As Long, _ b As Long, _ c As Long, _ d As Long, _ x As Long, _ s As Long, _ ac As Long) As Long a = LongOverflowAdd4(a, (b And d) Or (c And Not (d)), x, ac) a = LongLeftRotate(a, s) a = LongOverflowAdd(a, b) End Function     Private Function HH(a As Long, _ b As Long, _ c As Long, _ d As Long, _ x As Long, _ s As Long, _ ac As Long) As Long a = LongOverflowAdd4(a, b Xor c Xor d, x, ac) a = LongLeftRotate(a, s) a = LongOverflowAdd(a, b) End Function     Private Function II(a As Long, _ b As Long, _ c As Long, _ d As Long, _ x As Long, _ s As Long, _ ac As Long) As Long a = LongOverflowAdd4(a, c Xor (b Or Not (d)), x, ac) a = LongLeftRotate(a, s) a = LongOverflowAdd(a, b) End Function     ' ' Rotate a long to the right ' Function LongLeftRotate(value As Long, bits As Long) As Long Dim lngSign As Long Dim lngI As Long bits = bits Mod 32 If bits = 0 Then LongLeftRotate = value: Exit Function For lngI = 1 To bits lngSign = value And &HC0000000 value = (value And &H3FFFFFFF) * 2 value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And _ &H40000000) And &H80000000) Next LongLeftRotate = value End Function     ' ' Function to add two unsigned numbers together as in C. ' Overflows are ignored! ' Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long Dim lngHighWord As Long Dim lngLowWord As Long Dim lngOverflow As Long     lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) lngOverflow = lngLowWord \ 65536 lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF& LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&)) End Function     ' ' Function to add two unsigned numbers together as in C. ' Overflows are ignored! ' Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, Val3 As Long, val4 As Long) As Long Dim lngHighWord As Long Dim lngLowWord As Long Dim lngOverflow As Long     lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (Val3 And &HFFFF&) + (val4 And &HFFFF&) lngOverflow = lngLowWord \ 65536 lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + _ ((Val2 And &HFFFF0000) \ 65536) + _ ((Val3 And &HFFFF0000) \ 65536) + _ ((val4 And &HFFFF0000) \ 65536) + _ lngOverflow) And &HFFFF& LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&)) End Function     ' ' Convert an unsigned double into a long ' Private Function UnsignedToLong(value As Double) As Long If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow If value <= MAXINT_4 Then UnsignedToLong = value Else UnsignedToLong = value - OFFSET_4 End If End Function     ' ' Convert a long to an unsigned Double ' Private Function LongToUnsigned(value As Long) As Double If value < 0 Then LongToUnsigned = value + OFFSET_4 Else LongToUnsigned = value End If End Function

---

Code:

---

1 2 3 4 5 6

Sub test() Dim clcl Set clcl = CreateObject("GestionLicence.Licence") Range("Feuil2!A1") = 10: Range("Feuil3!A1") = 15 clcl.CalculSurTroisFeuilles ThisWorkbook End Sub

---

Bonsoir
Je vois qu'il y a quelques amélioration dans tes codes mais ça ne resoud toujours pas mon problème.
Mon problème se situe au niveau de ton module "Regs".
Lorsque je transfert ce module dans VB6 j'obtiens des lignes rouges (lignes avec PTRSAFE).
Je suis toujours a l'écoute merci....

Bonjour,
Vb6 n’utilise pas les directive de compilation #If il n'y à donc plus de PTRSAFE! de plus j'utilise GetSetting

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Private Function ReadRegistre(Path As String, Section As String, Key As String, Default) On Error Resume Next ReadRegistre = GetSetting(Path, Section, Key, Default) If Err Then ReadRegistre = "" Err.Clear: On Error GoTo 0 End Function Private Function WriteRegistre(Path As String, Section As String, Key As String, Setting As String) As Boolean On Error Resume Next SaveSetting Path, Section, Key, Setting WriteRegistre = Not CBool(Err.Number) Err.Clear: On Error GoTo 0 End Function Private Function SupprimerRegistre(Path As String, Section As String, Key As String) As Boolean On Error Resume Next DeleteSetting Path, Section, Key SupprimerRegistre = Not CBool(Err.Number) Err.Clear: On Error GoTo 0 End Function

---

Pièce jointe 306383