Sujet Précédent Sujet Suivant

Besoin d'aide par rapport a un script dans excel VBA URGENT!!!!!!!!!!!!

oliano Messages postés 5 Date d'inscription mardi 29 avril 2008 Statut Membre Dernière intervention 5 mai 2008 - 2 mai 2008 à 15:24
oliano Messages postés 5 Date d'inscription mardi 29 avril 2008 Statut Membre Dernière intervention 5 mai 2008 - 5 mai 2008 à 09:26
Bonjour,

Ca fait 3 jours que je galere sur mon probleme, et j'ai vraiment besoin que quelqu'un m'aide sinon je ne m'en sortirai jamais.

Mon objectif :
Je veux  creer un code dans excel VBA, qui me permette d'envoyer par mail (via outlook) une feuille excel et une autre piece jointe ( enregistree sur mon disque dur) en un clic.

Mes Scripts:

Public Sub runAll()
    
 ExportThis (Range("tabtosend"))


End Sub
---------------------------------------------------------------------------------------------------------------------


Sub ExportThis(exportsheetname As String)


    Dim vntSaveAsFileName As Variant, vntTemp As Variant
    Dim strExportPath As String, strExportFileName As String, strCurChr As String, strExportWbkName As String
    Dim intCurPos As Integer
    Dim lngLR As Long
    Dim width As Integer
    Dim height As Integer
    Dim i As Integer
    Dim rowFound As Integer


    'height = RangeDownAll(Sheets(exportsheetname).Cells(1, 1)).Rows.Count
   
    'width = RangeRightAll(Sheets(exportsheetname).Cells(1, 1)).Columns.Count


   
    width = RangeRightAll(Sheets(exportsheetname).Cells(1, 1)).Columns.Count
    With shtMain
      .Calculate
     
      strExportPath = .Range("rExportP")
      strExportFileName = .Range("rExportF")
      ChDir strExportPath
     
      vntSaveAsFileName = strExportPath & strExportFileName
      If vntSaveAsFileName = False Then
        Exit Sub
      End If
    End With
   
    With Application
      .ScreenUpdating = False
      .StatusBar = "Exporting the file '" & strExportFileName & "', please wait..."
    End With
   
    Range(Sheets(exportsheetname).Cells(1, 1), Sheets(exportsheetname).Cells(height, width)).Copy
 
   Workbooks.Add
 strExportWbkName = ActiveWorkbook.Name
    With Workbooks(strExportWbkName)
     With .ActiveSheet
        .Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
     
      End With
     
      On Error Resume Next
     Application.DisplayAlerts = False
      .SaveAs vntSaveAsFileName, xlCSV, , , , , , False
      Application.DisplayAlerts = True
      .Saved = True
      .Close
    End With




     'ALL DONE!
    With Application
      .StatusBar = False
      .ScreenUpdating = True
    End With
   
    If shtMain.Range("emailto") <> "" Then
        Dim nEmailRecepients As Integer
       
        nEmailRecepients = RangeRightAll(shtMain.Range("emailto")).Columns.Count
        
        emailCSVfile CStr(vntSaveAsFileName), GetStringList(shtMain.Range("emailto"), ";", True)
        shtMain.Range("mainStatus").Sheets(exportsheetname) = "Attempting to email " & vntSaveAsFileName
        shtMain.Range("mainStatus").Cells(1, 1) = "Attempting to email " & vntSaveAsFileName
       
    End If
       
End Sub
-----------------------------------------------------------------------------------------------------------------


Sub emailCSVfile(filelocation As String, emailRecepients As String)


Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim aExternalFiles As Variant
Dim extfile As Variant


On Error Resume Next


aExternalFiles = GetArray(GetStringList(shtMain.Range("externalfiles"), ",", True), ",")


mess_body = emailTemplate
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
    With MailOutLook
            .To = emailRecepients
            .Subject = "Listing " & Now()
            .Body = mess_body
           
            .Attachments.Add (filelocation)
           
            'add any other files
            For Each extfile In aExternalFiles
           
                .Attachments.Add (Trim(extfile))
                If err <> 0 Then MsgBox "Could not send " & extfile & ". Check file location."
               
            Next
           
            .DeleteAfterSubmit = Range("delete")
            Application.DisplayAlerts = False
            .Send
    End With


End Sub

Mon probleme
Le script marche parfaitement, excepte que la feuille excel que j' envoie est differenete de l'originale. En fait seules les premieres lignes sont copiees.  La feuille excel que j'utilise contient des lignes/colonne vides, et selon mon analyse, ces script copient les donnees contenues dans les lignes et colonnes j'usqu'au premier espace vide.En plus les couleurs et formats ne sont pas non plus copiees.
Ce que je voudrais, c'est que c'est  que le script me copie de facon EXACTE (clonage) ( couleur, forme, espace vide ou pas) la feuille excel a envoyer.
Je vous prie de venir a mon secour!!!!!!!!! please.
Merci d'avance!
Oliano

2 réponses

Réponse 1 / 2
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
3 mai 2008 à 14:35
Plutôt que .Body, essaie avec .HTMLBody

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 2 / 2
oliano Messages postés 5 Date d'inscription mardi 29 avril 2008 Statut Membre Dernière intervention 5 mai 2008
5 mai 2008 à 09:26
Merci pour ton message. J'ai essaye ce que tu m'as demande, mais rien a change.

Oliano
0

Discussions similaires

Affichage du userform dès l'ouverture du fichier excel
payhpayh7 -
aslalaud -

4 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
Le Modulo en VB6
elkasmi_ahmed -
econs -

2 réponses
[clos] script pour prendre des rendez sur mon site
cs_lyamcarter -
Julien39 -

1 réponse
Rejoignez-nous