VBA makro rada

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

VBA makro rada

Příspěvekod Dusan150 » 28 úno 2019 11:47

Dobrý deň
Mám na vás prosbu o radu resp. pomoc
Potrebujem priradiť makro v súbore excel (v prílohe) tak, aby sa daný hárok uložil na disk v PC z názvom daného hárku s reálnym dátumom a zároveň bol odoslaný na konkrétnu mailovú adresu.
Přílohy
VS.xlsm
(18.8 KiB) Staženo 28 x

Reklama
luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 28 úno 2019 15:52

Dobrý den, zkuste toto mělo by to být co potřebujete. Mám to od místních odborníků. Budete muset jenom upravit cestu atd.
Odesílá to v PDF ale jde to přenastavit i na celý sešit.

Kód: Vybrat vše

Sub OutlookPriloha()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
    '!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
    'Tools / References / Microsoft Outlook x.x Object Library
   
    With ActiveSheet
        With .Range("C39")
            .Value = Now()
            .NumberFormat = "d/m/yy h:mm;@"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("D37").Value = "bb@cosi.cz"
        Range("D38").Value = "bb@cosi.cz"
       
      ' Uložení souboru
      'Range C35 = datum
      'Range L1 = Jméno
     
        Soubor = "C:umístnění\" & .Range("C35") & " " & .Range("L1") & ".pdf"
       
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set objNsp = OutApp.Application.GetNamespace("MAPI")  'CORRECTION to Refer to the OutLook Application correctly
    Set colSyc = objNsp.SyncObjects
   
    adresat = "bbb@cosi.cz"
   
   
    With OutMail
        'adresát
        .To = adresat
   
        'kopie pro
         .CC = "bbb@cosi.cz"
       
        'kopie pro
        '.CC = "bbb@cosi.cz"
       
        'skrytá kopie pro
        .BCC = "bbb@cosi.cz"
       
        'předmět zprávy
        .Subject = "Vepiš text"
       
        'text zprávy a určení buňky
        .Body = "Text zprávy"
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add Soubor
       
        'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
        'Dostupné od verze Office 2007
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        'odeslání zprávy
        .Send
       
    End With
    Range("D37:D38").ClearContents
    Range("C39").ClearContents
    Range("B6:J20").ClearContents
    Range("B24:J33").ClearContents
   
    For i = 1 To colSyc.Count
        Set objSyc = colSyc.Item(i)
        objSyc.Start
    Next i
    'OutApp.Quit
    MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
    'uvolnění z paměti
    Set OutMail = Nothing: Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing: Set OutApp = Nothing
End Sub

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

Re: VBA makro rada

Příspěvekod Dusan150 » 28 úno 2019 17:20

Ďakujem za odpoveď, ale nepodarilo sa mi to spraviť. Som vo VBA začiatočník :-(

luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 28 úno 2019 18:16

Zkusím Vám to vysvětlit snad mě tu někdo neukamenuje.
Celou proceduru vložit do modulu makra. Nevím jak se přesně co nazívá ale snad si poradíte
Procedura se spuští tlačítkem. ( vložit objekt a přiřadit makro)
Taky nejsem žádný expert každou chvíli mě tu někdo radí.
Hlavně nezapomět si přečíst hned druhou větu v proceduře.

Kód: Vybrat vše

Sub OutlookPriloha()
Dim objNsp As Object, colSyc As Object, objSyc As Object, i As Integer, adresat As String, Soubor As String
    '!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
    'Tools / References / Microsoft Outlook x.x Object Library
   
    With ActiveSheet
        With .Range("C39") ' toto je buňka kde se na listě vypíše datum a čas
            .Value = Now()
            .NumberFormat = "d/m/yy h:mm;@"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("D37").Value = "bb@cosi.cz" 'emailové adresy, které se vloží do uloženého dokumentu
        Range("D38").Value = "bb@cosi.cz"
       
      ' Uložení souboru
      'Range C35 = datum
      'Range L1 = Jméno
     
        Soubor = "C:umístnění\" & .Range("C35") & " " & .Range("L1") & ".pdf" ' Tady se vylní cesta kam chcete soubor uložit, C35     
       A L1 název a datum souboru pod, kterým se uloží.
       
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set objNsp = OutApp.Application.GetNamespace("MAPI")  'CORRECTION to Refer to the OutLook Application correctly
    Set colSyc = objNsp.SyncObjects
   
    adresat = "bbb@cosi.cz" ' emailová adresa příjemce
   
   
    With OutMail
        'adresát
        .To = adresat
   
        'kopie pro
         .CC = "bbb@cosi.cz"
       
         'skrytá kopie pro
        .BCC = "bbb@cosi.cz"
       
        'předmět zprávy
        .Subject = "Vepiš text" 'Sem si napíšete předmět odesílané zprávy
       
        'text zprávy a určení buňky
        .Body = "Text zprávy"  'obsah zprávy
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add Soubor
       
        'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
        'Dostupné od verze Office 2007
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        'odeslání zprávy
        .Send
       
    End With
    Range("D37:D38").ClearContents  'Vymaže buňky
    Range("C39").ClearContents
    Range("B6:J20").ClearContents
    Range("B24:J33").ClearContents
   
    For i = 1 To colSyc.Count
        Set objSyc = colSyc.Item(i)
        objSyc.Start
    Next i
    'OutApp.Quit
    MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
    'uvolnění z paměti
    Set OutMail = Nothing: Set objNsp = Nothing: Set colSyc = Nothing: Set objSyc = Nothing: Set OutApp = Nothing
End Sub

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

Re: VBA makro rada

Příspěvekod Dusan150 » 28 úno 2019 19:08

Ďakujem pekne za snahu :thumbup:
Som amatér v tomto a nepodarilo sa mi to spojazdniť.

luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 01 bře 2019 05:32

Dobrý den, v příloze máte soubor jenom si tam vložte kam to chcete ukládat a adresáta emailu.
Pokud budete chtít odesílat soubor v excelu tak dejte vedět večer bych Vám ho poslal.
Snad Vám to pomůže.
Ještě název listu neumím vložit přímo do procedury tak je tam pomocná buňka L2
Zapoměl jsem Vám tam dat tlacitko na spousteni makra
Přílohy
VS.xlsm
(25 KiB) Staženo 33 x

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

Re: VBA makro rada

Příspěvekod Dusan150 » 01 bře 2019 16:49

Poprosím aj o tú úpravu aby sa to odosielalo v excelovom formáte.
Ďakujem veľmi ste mi pomohli :thumbup: :thumbup: :thumbup:

luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 01 bře 2019 18:11

Dobrý večer, posílám slíbené.
Rád pomůžu, ale není to má práce. Vytvořil Elninoslov tomu patří dík.
Vyzkoušejte a uvidíte.
Přílohy
VS(1).xlsm
(30.31 KiB) Staženo 33 x

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

Re: VBA makro rada

Příspěvekod Dusan150 » 02 bře 2019 10:24

Ďakujem vám aj Elninoslovi
Keďže pri odoslaní v exceli sa príjemcovi zobrazí aj oblasť kde je makro, bude lepšia verzia v PDF (príjemca nemusí dokument upravovať)
Lenže teraz nastal problém s tým že keď zabezpečím hárok tak makro sa nespustí :(

luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 02 bře 2019 12:57

Jestli to správně chápu, pokud se odesílá sešit v PDF tak přece není potřeba zabezpečovat list.

Dusan150
nováček
Příspěvky: 7
Registrován: únor 19
Pohlaví: Muž
Stav:
Offline

Re: VBA makro rada

Příspěvekod Dusan150 » 02 bře 2019 15:11

ten problém s makrom som vyriešil vo VBA som na začiatku zadal odomknúť a na konci zamknut harok, pretože ten hlavný excel súbor bude používať cca 30 ľudí tak aby nedošlo k nedovoleným zásahom do štruktúry ap.
Lenže keď už bolo všetko hotové preniesol som súbor do PC v ktorom má byť používaný a po upravení makra súbor odošle na danú adresuale vo VBA mi vyhodí hlášku Run- time error´1004´: čiže súbor neuloží a keď otvorím Debug zobrazuje:
Přílohy
problem VBA.jpg

luko02420
Level 2
Level 2
Příspěvky: 203
Registrován: únor 12
Pohlaví: Nespecifikováno
Stav:
Offline

Re: VBA makro rada

Příspěvekod luko02420 » 02 bře 2019 16:31

To je zajimave me to funguje. Ale mam obavu ze Vám nedokazi poradit. Snad jenom info, me se to stalo taky, ze jsem doma vytvoril sesit a v praci mi z nejakeho duvodu nefungoval. Tak jsem proste vytvoril to stejne v praci a byl klid.
Vím ze to neni zadna rada ale opravdu jsem laik. Omlouvám se.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47
  • rada se steam
    od Mladkov204 » 17 srp 2023 20:11 » v Vše ostatní (sw)
    3
    1932
    od Mladkov204 Zobrazit poslední příspěvek
    19 srp 2023 10:41
  • rada s grafikou Příloha(y)
    od Mladkov204 » 19 srp 2023 10:48 » v Problémy s hardwarem
    2
    1015
    od Mladkov204 Zobrazit poslední příspěvek
    19 srp 2023 10:56
  • SkyDSL rada
    od krakenus600 » 21 zář 2023 14:31 » v Vše ostatní (inet)
    2
    1297
    od krakenus600 Zobrazit poslední příspěvek
    21 zář 2023 14:54
  • Rada jaká RAM a SSD? NTB Příloha(y)
    od pikaso.andreas » 05 zář 2023 08:18 » v Rady s výběrem hw a sestavením PC
    10
    1414
    od pikaso.andreas Zobrazit poslední příspěvek
    06 zář 2023 09:36

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti