Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64696 Skopiuj do schowka Problem z wysłaniem @ dla udostępnionego pliku
Autor Wiadomość
adamtg 
Fan Excela


Posty: 85
Wysłany: 09-04-2019, 15:28   Problem z wysłaniem @ dla udostępnionego pliku

Hey,

Mam problem z makrem, które wysyła mi zrzut danych w postaci pliku graficznego za pomocą Outlook. Wszystko działa idealnie do momentu kiedy nie udostępnie pliku dla innych użytkowników - wtedy po uruchomieniu makra tworzy się nowy, pusty arkusz w pliku.
Poniżej zamieszczam kod- będę super wdzięczny za pomoc.


Kod:

Sub EmailWithRange()
    Dim olApp As Object
    Dim NewMail As Object
    Dim ChartName As String
    Dim imgPath As String
   
    On Error GoTo error
   
    Set olApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    tmpImageName = VBA.Environ$("temp") & "\tempfile.jpg"
    Set RangeToSend = ActiveSheet.Range("B7:H59")
    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
   
    Set sht = Sheets.Add
    sht.Shapes.AddChart
    sht.Shapes.Item(1).Select
    Set objChart = ActiveChart

    With objChart
        .ChartArea.Height = RangeToSend.Height
        .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = msoFalse
        .ChartArea.Border.LineStyle = xlLineStyleNone
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With
    sht.Delete
    Set olMail = olApp.CreateItem(0)
   
    With olMail
        .Subject = "PR - Screen -" & (" ") & Range("C10") & (" ") & Range("D10") & (" ") & Range("E10")
        .To = Range("ACK13") & (";") & Range("ACK14") & (";") & Range("ACK15") & (";") & Range("ACK16") & (";") & Range("ACK17") & (";") & Range("ACK18")
        .CC = ""
        .BCC = ""
        .HTMLBody = "<br><br><img src=" & "'" & tmpImageName & "'/>"
        .HTMLBody = .HTMLBody & ""
        .Display
    End With

error:
    Set olApp = Nothing
    Set NewMail = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
ID posta: 365724 Skopiuj do schowka
 
 
Tajan


Pomógł: 4351 razy
Posty: 9667
Wysłany: 09-04-2019, 18:04   

To makro używa funkcji które nie są dozwolone w udostępnionym skoroszycie (wstawianie wykresu, usuwanie arkusza). Spróbuj zmienić linię:
Kod:
Set sht = Sheets.Add
na
Kod:
Set sht = Workbooks.Add.Sheets(1)
oraz
Kod:
sht.Delete
na
Kod:
sht.Parent.Close False
ID posta: 365741 Skopiuj do schowka
 
 
adamtg 
Fan Excela


Posty: 85
Wysłany: 10-04-2019, 12:28   

Wszystko działa! Dziękuje
ID posta: 365789 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe