Bonjour Le Forum,
J'essaie de mettre un Cotateur avec qques macros en ligne. Toutes les macros fontionnnent sauf que j'ai un soucis avec le compteur du numéro de cotation
qui tant que le fichier est à l'écran tourne bien et incrémente au fur et à mesure mais dés que je quitte l'application et que je rappelle mon cotateur il redémarre avec toujours le même numéro et non le dernier numéro enregistré.
Quelqu'un pourrait-il m'aider à comprendre ce qui ne va pas dans mon code d'autant que lorsqu'il n'est pas en ligne ... il fonctionne bien.
Est ce à tout hasard parceque lorsque'il est en ligne il est en lecture seule ? Dans ce cas comment désactiver la lecture seule ?
Merci pour votre aide précieuse.
Public Flag As Boolean
Sub enregistre()
Application.ScreenUpdating = False
If Not Flag Then
Dim ApplicOutlook As Object
Dim ElémentCourrier As Object
Dim cellule As Range
Dim Sujet As String
Dim Email As String
Dim Destinataire As String
Dim mois As String
Dim Msg As String
MsgBox "Vous devez d'abord valider votre cotation pour pouvoir l'enregistrer."
Exit Sub
End If
Flag = False
Application.DisplayAlerts = False
[G1].Value = [G1].Value + 1
Range("E1:G1").Font.ColorIndex = 0
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("D3").Select
Application.StatusBar = False
For Each Obj In ActiveSheet.DrawingObjects
Obj.Delete
Next Obj
ThisWorkbook.Save
ChDir "\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\"
ActiveWorkbook.SaveAs Filename:="\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\" & [E1].Value & " " & Format([F1].Value, "yyyymm") & " " & [G1] & ".xls", FileFormat:=xlNormal
Set ApplicOutlook = CreateObject("Outlook.Application")
Sujet = "CEVA FRANCE OFFRE NR" & " " & [E1] & " " & Format([F1].Value, "yyyymm") & " " & [G1]
'Message d'envoi
Msg = "Madame, Monsieur " & Destinataire & vbCrLf & vbCrLf
Msg = Msg & "Nous vous prions de bien vouloir trouver ci joint notre offre de transport Aérien" & vbCrLf & vbCrLf
Msg = Msg & "Nous vous souhaitons bonne réception de la présente" & vbCrLf & vbCrLf
Msg = Msg & "Cordialement," & vbCrLf & vbCrLf
Msg = Msg & "CEVA France"
'Création du message et envoi
Set ElémentCourrier = ApplicOutlook.CreateItem(0)
With ElémentCourrier
.Attachments.Add ActiveWorkbook.FullName
.To = Email
.Subject = Sujet
.Body = Msg
.Display
End With
Workbooks.Open ("\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\Archives.xls")
Windows("COTATEUR.xls").Activate
Range("E1:G1").Select
Selection.Font.ColorIndex = 0
Range("I1").Select
Range("C8").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "yyyy"
Windows("COTATEUR.xls").Activate
Range("D17").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "mm"
Windows("COTATEUR.xls").Activate
Range("G1").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("F6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("J14:M14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("I6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("H27:I27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("H26:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("K6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("L6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("M24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("N6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Range("A6").Select
Windows("COTATEUR.xls").Activate
Range("Q1").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A6").Select
' ARCHIVERREPERTOIRE Macro
' Macro enregistrée le 02/01/2008 par cdgsazr
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).EntireRow.Select
Selection.Copy
Sheets("ENREG").Select
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Feuil1").Select
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).Offset(1, 0).Select
Sheets("Feuil1").Select
Range("A6").Select
Application.DisplayAlerts = False
ThisWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
"\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATION\ARCHIVES.XLS", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close (False)
Msg = "Votre Cotation a bien été sauvegardée, Merci !"
title = "Sauvegarde de la cotation actuelle"
style = vbOKOnly + vbInformation
Reponse = MsgBox(Msg, style, title)
Application.ScreenUpdating = True
Windows("COTATEUR.xls").Activate
Sheets("Accueil").Select
Application.DisplayAlerts = True
End Sub
J'essaie de mettre un Cotateur avec qques macros en ligne. Toutes les macros fontionnnent sauf que j'ai un soucis avec le compteur du numéro de cotation
qui tant que le fichier est à l'écran tourne bien et incrémente au fur et à mesure mais dés que je quitte l'application et que je rappelle mon cotateur il redémarre avec toujours le même numéro et non le dernier numéro enregistré.
Quelqu'un pourrait-il m'aider à comprendre ce qui ne va pas dans mon code d'autant que lorsqu'il n'est pas en ligne ... il fonctionne bien.
Est ce à tout hasard parceque lorsque'il est en ligne il est en lecture seule ? Dans ce cas comment désactiver la lecture seule ?
Merci pour votre aide précieuse.
Public Flag As Boolean
Sub enregistre()
Application.ScreenUpdating = False
If Not Flag Then
Dim ApplicOutlook As Object
Dim ElémentCourrier As Object
Dim cellule As Range
Dim Sujet As String
Dim Email As String
Dim Destinataire As String
Dim mois As String
Dim Msg As String
MsgBox "Vous devez d'abord valider votre cotation pour pouvoir l'enregistrer."
Exit Sub
End If
Flag = False
Application.DisplayAlerts = False
[G1].Value = [G1].Value + 1
Range("E1:G1").Font.ColorIndex = 0
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("D3").Select
Application.StatusBar = False
For Each Obj In ActiveSheet.DrawingObjects
Obj.Delete
Next Obj
ThisWorkbook.Save
ChDir "\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\"
ActiveWorkbook.SaveAs Filename:="\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\" & [E1].Value & " " & Format([F1].Value, "yyyymm") & " " & [G1] & ".xls", FileFormat:=xlNormal
Set ApplicOutlook = CreateObject("Outlook.Application")
Sujet = "CEVA FRANCE OFFRE NR" & " " & [E1] & " " & Format([F1].Value, "yyyymm") & " " & [G1]
'Message d'envoi
Msg = "Madame, Monsieur " & Destinataire & vbCrLf & vbCrLf
Msg = Msg & "Nous vous prions de bien vouloir trouver ci joint notre offre de transport Aérien" & vbCrLf & vbCrLf
Msg = Msg & "Nous vous souhaitons bonne réception de la présente" & vbCrLf & vbCrLf
Msg = Msg & "Cordialement," & vbCrLf & vbCrLf
Msg = Msg & "CEVA France"
'Création du message et envoi
Set ElémentCourrier = ApplicOutlook.CreateItem(0)
With ElémentCourrier
.Attachments.Add ActiveWorkbook.FullName
.To = Email
.Subject = Sujet
.Body = Msg
.Display
End With
Workbooks.Open ("\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATIONS\Archives.xls")
Windows("COTATEUR.xls").Activate
Range("E1:G1").Select
Selection.Font.ColorIndex = 0
Range("I1").Select
Range("C8").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "yyyy"
Windows("COTATEUR.xls").Activate
Range("D17").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "mm"
Windows("COTATEUR.xls").Activate
Range("G1").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("F6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("J14:M14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("I6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("H27:I27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("H26:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("K6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("D26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("L6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("COTATEUR.xls").Activate
Range("M24").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("N6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Range("A6").Select
Windows("COTATEUR.xls").Activate
Range("Q1").Select
Selection.Copy
Windows("ARCHIVES.XLS").Activate
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A6").Select
' ARCHIVERREPERTOIRE Macro
' Macro enregistrée le 02/01/2008 par cdgsazr
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).EntireRow.Select
Selection.Copy
Sheets("ENREG").Select
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Feuil1").Select
ActiveSheet.Columns(1).Find("*", , , , , xlPrevious).Offset(1, 0).Select
Sheets("Feuil1").Select
Range("A6").Select
Application.DisplayAlerts = False
ThisWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
"\\Mrssfp01\CEVAFrance\documents\Outils\COTATEUR AIR EXPORT\ARCHIVES COTATION\ARCHIVES.XLS", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close (False)
Msg = "Votre Cotation a bien été sauvegardée, Merci !"
title = "Sauvegarde de la cotation actuelle"
style = vbOKOnly + vbInformation
Reponse = MsgBox(Msg, style, title)
Application.ScreenUpdating = True
Windows("COTATEUR.xls").Activate
Sheets("Accueil").Select
Application.DisplayAlerts = True
End Sub
