Convertir Excel/VBA 32 bits en 64 bits

Le 21/12/2015 à 17:48

Bonjour à tous,

je suis un peu débutant en VBA et j'aimerais votre aide par rapport à un programme Excel que j'ai trouvé sur la toile.

Quand je lance celui-ci, il m'indique qu'une mise à jour du code est nécessaire pour pouvoir exécuter celui-ci sur un système 64 bits.

J'aimerais savoir quelles-sont les différences et que dois-je modifier/mettre à jour pour que ce programme sois fonctionnel ?

Merci à vous.

L'erreur obtenue :

Erreur de compilation:

Le code contenu dans ce projet doit être mis à jour pour pouvoir être utilisé sur les sytèmes 64 bits.

Vérifiez et mettez à jour les instructions Declare, puis marquez-les avec l'attribut PtrSafe.

Et le code VBA :

Option Explicit

'http://www.commentcamarche.net/faq/28165-modele-facturation

Public NvVoit As Integer
Public NumClient As Long
Public NumFacture As Long
Public LigFacture As Integer
Public VoirFact As Boolean
Public LigClient As Long
Public DebutFacture As Long
Public DebutClient As Long
Public EnvoiRapp As Integer

Public Cmin As Long
Public Cmax As Long
Public LCmin As Long
Public LCmax As Long
Public Lmin As Long
Public Lmax As Long
Public Fmin As Long
Public Fmax As Long
Public Pmin As Long
Public Pmax As Long
Public PLmin As Long
Public PLmax As Long
Public NumPerso As Long

Public HorsContext As Boolean
Public HorsC2 As Boolean
Public RempliFact As Boolean

Public NomClient As String
Public Mois
Public Article
Public StopImprime As Boolean
Public Montant As Single
Public RetourMontant As Single
Public TypePayer As Byte

Public AffiStat As Boolean
Public AffiPerso As Boolean
Public ModeAffiR As Integer
Public ReInitialiserIntBT As Boolean

Public EX As New Application
Public Book As Workbook

'pour enlever la croix rouge d'un UF
Public Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub InitDebut()
    DebutClient = Sheets("Acceuil").Range("AB6")
    DebutFacture = Sheets("Acceuil").Range("AB7")
End Sub

Function CompTR(TD As String, TF As String) As Integer
Dim TBD, TBF
Dim DD As Long, DF As Long
    'On Error Resume Next
    TBD = Split(TD, "/")
    TBF = Split(TF, "/")
    DD = DateSerial(TBD(2), TBD(1), TBD(0))
    DF = DateSerial(TBF(2), TBF(1), TBF(0))
    If DD = DF Then
        CompTR = 1
    ElseIf DD > DF Then
        CompTR = 2
    ElseIf DD < DF Then
        CompTR = 3
    End If
End Function
Public Function InitPerso() As Boolean
    PLmin = 6
    Pmin = 1
    PLmax = Sheets("Intervenants").Range("A65536").End(xlUp).Row
    If PLmax < 6 Then
        PLmax = 5: Pmax = 0
    Else
        InitPerso = True
        Pmax = Sheets("Intervenants").Range("A65536").End(xlUp)
        InitPerso = True
    End If
End Function

Public Function InitFMin() As Boolean
    If DebutFacture = 0 Then
        InitDebut
    End If
    Lmin = 6
    Fmin = Sheets("Liste Factures").Range("B6")
    If Fmin < DebutFacture Then 'pas encore de facture
        Fmin = DebutFacture: Fmax = Fmin
        Lmax = 6:
    Else
        Lmax = Sheets("Liste Factures").Range("B65536").End(xlUp).Row
        Fmin = Sheets("Liste Factures").Range("B6")
        Fmax = Sheets("Liste Factures").Range("B65536").End(xlUp)
        InitFMin = True
    End If
End Function

Public Function InitCMin() As Boolean
Dim C As Long
On Error Resume Next
    If DebutClient = 0 Then
        InitDebut
    End If
    Cmin = Sheets("Liste Clients").Range("A6")
    LCmin = 6

 '   Cmax = Sheets("Liste Clients").Range("A65536").End(xlUp)
    If Cmin < DebutClient Then 'il n'y a pas encore de client
        Cmin = DebutClient: Cmax = Cmin
        LCmax = 6
    Else
        LCmax = Sheets("Liste Clients").Range("A65536").End(xlUp).Row
        Cmin = DebutClient
        Cmax = Sheets("Liste Clients").Cells(LCmax, 1)
        InitCMin = True
        If Err Then
            MsgBox "Erreur 327 : InitCmin" & Chr(13) & "Veuillez prévenir le concepteur en mentionnant l'erreur SVP."
        End If
    End If
End Function
Public Function CH_NvNumClient()
Dim N
    HorsContext = True
    N = Sheets("Liste Clients").Range("A65536").End(xlUp).Row
    If N = 5 Then
        N = Sheets("Acceuil").Range("AB6")
        CH_NvNumClient = N
        Cmin = N: Cmax = N: Lmin = 6: Lmax = 6
    Else
        CH_NvNumClient = Sheets("Liste Clients").Cells(N, 1) + 1
        InitCMin
    End If
    HorsContext = False
End Function
Public Function CH_NvNumFacture()
Dim N As Long
    N = Sheets("Liste Factures").Range("B65536").End(xlUp).Row
    If N < 6 Then
        CH_NvNumFacture = DebutFacture
    Else
        CH_NvNumFacture = Sheets("Liste Factures").Cells(N, 2) + 1
    End If
End Function
Public Function CH_LigFacture(NumFact)
    CH_LigFacture = NumFact - DebutFacture + 6
End Function
Public Function CH_LigClient(Optional NC As Long = 0)
Dim L As Long
    If NC > 0 Then
        L = NC - DebutClient + 6
    Else
        L = NumClient - DebutClient + 6
    End If
    CH_LigClient = L
    NomClient = Sheets("Liste Clients").Cells(L, 3)
End Function
Sub RemplirFacture(NumFact)
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim FL3 As Worksheet
Dim Cel As Range
Dim B As String, L As Integer, i As Integer, TB
Dim a$, T As Single, HT As Single, TTC As Single, TVA As Single, MTVA As Single
    'RempliFact = True
    InitPerso
Dim IntX() As Boolean
ReDim IntX(Pmin To Pmax)
    RempliFact = True
    On Error GoTo FauteFacture
    Err.Description = "Erreur 101 : Affichage facture"
    Set FL1 = Sheets("facture")
    Set FL2 = Sheets("Liste Factures")
    Set FL3 = Sheets("Liste Clients")
    Err.Description = "Erreur 102 : Affichage facture"
    LigFacture = CH_LigFacture(NumFact)
    NumClient = FL2.Cells(LigFacture, 1)
    LigClient = CH_LigClient()
    For Each Cel In Range("C31:L44")
        Cel = ""
    Next Cel
    FL1.Range("L6") = NumFact
    FL1.Range("J9") = FL2.Cells(LigFacture, 3)
    FL1.Range("D16") = Format(FL2.Cells(LigFacture, 1), "#0#-") _
    & Format(CStr(NumFact), "#0#")
    B = FL3.Cells(LigClient, 2) & " " & FL3.Cells(LigClient, 3)
    FL1.Range("L9") = B
    B = B & " " & FL3.Cells(LigClient, 4)
    FL1.Range("J14") = B
    B = FL3.Cells(LigClient, 5) & " " & FL3.Cells(LigClient, 6)
    If FL3.Cells(LigClient, 7) <> "" Then B = B & " Bt:" & FL3.Cells(LigClient, 7)
    FL1.Range("J15") = B
    B = FL3.Cells(LigClient, 8) & " " & FL3.Cells(LigClient, 9)
    FL1.Range("J16") = B
    TB = Split(FL2.Cells(LigFacture, 13), ";")
    FL1.Range("C22") = TB(1)
    FL1.Range("I22") = TB(0)
    FL1.Range("D25") = TB(2)
    FL1.Range("E47") = FL2.Cells(LigFacture, 5) / 100
    L = 14: a$ = ""
    While FL2.Cells(LigFacture, L) <> ""
        TB = Split(FL2.Cells(LigFacture, L), ";")
        FL1.Cells(L + 17, 3) = TB(1)
        FL1.Cells(L + 17, 7) = TB(4)
        FL1.Cells(L + 17, 8) = TB(2)
        IntX(TB(5)) = True
        T = Round(TB(2) * TB(4), 2): HT = HT + T
        TVA = T * FL1.Range("E47"): TTC = TTC + T + TVA: MTVA = MTVA + TVA
        FL1.Cells(L + 17, 10) = T
        FL1.Cells(L + 17, 12) = T + TVA
        L = L + 1
    Wend
    For i = Pmin To Pmax
        If IntX(i) Then
            a$ = a$ & " - " & Sheets("Intervenants").Cells(i + 5, 2)
            a$ = a$ & " " & Sheets("Intervenants").Cells(i + 5, 3)
        End If
    Next i
    FL1.Range("D25") = a$
    FL1.Range("H47") = HT
    FL1.Range("H48") = MTVA
    FL1.Range("L46") = TTC
    If Not StopImprime Then
        If EnvoiRapp > 0 Then
            MettreRappel EnvoiRapp
        Else
            EffacerRappel
        End If
        If NumFact > Fmax Then
            InitFMin
            Sheets("facture").ChangeFacture.Max = Fmax
            Sheets("facture").ChangeFacture.Min = Fmin
        End If
        FL1.Range("R29") = NumFact
    End If

Sortie:
    RempliFact = False
Exit Sub
FauteFacture:
    MsgBox Err.Description, vbCritical, "Affichage facture"
    Resume Sortie
End Sub

Sub RemplirFacture1(NumFact)
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim FL3 As Worksheet
Dim Cel As Range
Dim B As String, L As Integer, i As Integer, TB
Dim a$, T As Single, HT As Single, TTC As Single, TVA As Single, MTVA As Single
    HorsContext = False

    'Sheets("facture").Activate
    'ActiveWindow.DisplayGridlines = True
    Application.ScreenUpdating = False
    On Error GoTo FauteFacture
    Err.Description = "Erreur 101 : Impression facture"
    Set FL1 = Sheets("facture")
    Set FL2 = Sheets("Liste Factures")
    Set FL3 = Sheets("Liste Clients")
    Err.Description = "Erreur 102 : Impression facture"
    LigFacture = CH_LigFacture(NumFact)
    NumClient = FL2.Cells(LigFacture, 1)
    LigClient = CH_LigClient()
    FL1.Select
    Range("C31:L44").Select
    Selection.ClearContents
    FL1.Range("L6") = NumFact
    FL1.Range("J9") = FL2.Cells(LigFacture, 3)
    B = FL3.Cells(LigClient, 2) & " " & FL3.Cells(LigClient, 3)
    FL1.Range("L9") = B
    B = B & " " & FL3.Cells(LigClient, 4)
    FL1.Range("J14") = B
    B = FL3.Cells(LigClient, 5) & " " & FL3.Cells(LigClient, 6)
    If FL3.Cells(LigClient, 7) <> "" Then B = B & "Bt" & FL3.Cells(LigClient, 7)
    FL1.Range("J15") = B
    B = FL3.Cells(LigClient, 8) & " " & FL3.Cells(LigClient, 9)
    FL1.Range("J16") = B
    TB = Split(FL2.Cells(LigFacture, 13), ";")
    FL1.Range("C22") = TB(0) & " / " & TB(1)
    FL1.Range("J22") = FL2.Cells(LigFacture, 4)
    FL1.Range("D25") = TB(2)
    FL1.Range("E47") = FL2.Cells(LigFacture, 5) / 100
    L = 14
    Err.Description = "Erreur 103 : Impression facture"

    While FL2.Cells(LigFacture, L) <> ""
        TB = Split(FL2.Cells(LigFacture, L), ";")
        FL1.Cells(L + 17, 4) = TB(1)
        FL1.Cells(L + 17, 7) = TB(4)
        FL1.Cells(L + 17, 8) = TB(2)
        FL1.Cells(L + 17, 3) = CVDate(DateSerial(TB(5), TB(6), TB(7)))
        T = Round(TB(2) * TB(4), 2): HT = HT + T
        TVA = T * FL1.Range("E47"): TTC = TTC + T + TVA: MTVA = MTVA + TVA
        FL1.Cells(L + 17, 10) = T
        FL1.Cells(L + 17, 12) = T + TVA
        L = L + 1
    Wend
    FL1.Range("H47") = HT
    FL1.Range("H48") = MTVA
    FL1.Range("L46") = TTC
    FL1.Select
    Range("A4").Select
    ActiveWindow.DisplayGridlines = False
Sortie:
    Application.ScreenUpdating = True
Exit Sub
FauteFacture:
    a$ = "Une erreur indéterminée est survenue dans " & Chr(13)
    a$ = a$ & "l'affichage de la facture N°" & NumFacture & Chr(13)
    a$ = a$ & "Veuillez prévenir le concepteur de l'appli en explicant " & Chr(13)
    a$ = a$ & "les circonstances avec un maximum de détals"
    MsgBox a$, vbCritical, "Impression facture"
    Resume Sortie
End Sub
Sub OuvreAide(Optional Page As Integer = 0)

Dim Chemin As String

    On Error GoTo Ouvre
    EX.ScreenUpdating = False
    EX.Workbooks("Lermite AIDE.xls").Activate
    EX.WindowState = xlMinimized
    EX.WindowState = xlNormal
Sortie:
    Select Case Page
    Case 0
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Mode d'emploi").Activate
    Case 1
        EX.Workbooks("Lermite AIDE.xls").Worksheets("NV_Client").Activate
    Case 2
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Client1").Activate
    Case 3
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Client2").Activate
    Case 4
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Facture").Activate
    Case 5
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Facture2").Activate
    Case 6
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Facture3").Activate
    Case 7
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Facture4").Activate
    Case 8
        EX.Workbooks("Lermite AIDE.xls").Worksheets("AjustData").Activate
    Case 9
        EX.Workbooks("Lermite AIDE.xls").Worksheets("Outils").Activate
    End Select
    EX.ScreenUpdating = True
sortie2:
Exit Sub
Ouvre:

    On Error GoTo TrouvePas
    Chemin = ThisWorkbook.Path & "\" & "Lermite AIDE.xls"
    Set EX = CreateObject("Excel.application")
    EX.ScreenUpdating = False
    EX.Visible = True
    EX.Workbooks.Open Chemin
    EX.Workbooks("Lermite AIDE.xls").Worksheets("Mode d'emploi").Activate
    Resume Sortie
TrouvePas:
    MsgBox "Le fichier d'aide est introuvable, soit il à été supprimer ou déplacer", vbCritical, "Appel Aide"
    Resume sortie2
End Sub

Merci d'avance !

Le 21/12/2015 à 18:27

Bonsoir,

A voir si cela fonctionne (n'ayant pas le fichier je n'ai pas peu tester)

Rajouter " PtrSafe " (Public Declare PtrSafe Function) ( a la fin de la déclaration des variables et fonctions )

Public Declare PtrSafe Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare PtrSafe Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Si cela ne fonctionne pas, désolé je n'irai pas plus loin, j'ai déjà dépassé mais limites

Edit : Il faudra peut être modifier la déclaration de variable As Long par As LongPtr

http://www.jkp-ads.com/articles/apideclarations.asp

Cdt

Harissa

Le 22/12/2015 à 19:52

Merci de ta réponse, j'ai essayé de résoudre certains problème au niveau de la compatibilité mais il y a beaucoup de différence et étant donné que le code ne m'appartient pas j'ai beaucoup de mal à tout corriger mais c'est gentil d'avoir essayé !

Je vais essayer de recréer le même programme en me basant de la version 32 bits, ce sera plus simple pour mes yeux !

Merci encore, si quelqu'un à des solutions, je reste ouvert aux propositions !

Lascage

Le 22/12/2015 à 21:13

N’hésites pas à nettoyer ton fichier de toutes données sensibles et à l'envoyer, tu auras plus de chance de succès de réponses et donc d'aides !

Cdt

Harissa.

Le 23/12/2015 à 15:13

Pas de soucis, Voici le fichier Excel !

146modele-facturation.zip (167.96 Ko)

Merci encore ! J'ai réussie a faire fonctionner quelques fonctions mais ce n'est pas encore ça

Rechercher des sujets similaires à "convertir vba bits"