Rozdíly
Zde můžete vidět rozdíly mezi vybranou verzí a aktuální verzí dané stránky.
| Obě strany předchozí revize Předchozí verze Následující verze | Předchozí verze Následující verze Obě strany příští revize | ||
|
programovani:vba [24.06.2014 11:06] miloush [Trim] |
programovani:vba [17.03.2015 18:32] miloush |
||
|---|---|---|---|
| Řádek 107: | Řádek 107: | ||
| Next i | Next i | ||
| + | End Sub | ||
| + | </code> | ||
| + | Přidat věk ze začátku opakování v den narození... | ||
| + | <code> | ||
| + | Sub VěkDoKalendáře() | ||
| + | |||
| + | Dim contacts As MAPIFolder | ||
| + | Dim a As AppointmentItem | ||
| + | Dim r As RecurrencePattern | ||
| + | Dim o As AppointmentItem | ||
| + | |||
| + | Dim born As Date | ||
| + | | ||
| + | | ||
| + | Set contacts = Session.PickFolder | ||
| + | |||
| + | For i = contacts.Items.Count To 1 Step -1 | ||
| + | Set a = contacts.Items(i) | ||
| + | If a.IsRecurring And a.Start < #1/1/2004# Then | ||
| + | born = DateAdd("yyyy", 9, a.Start) | ||
| + | Set r = a.GetRecurrencePattern() | ||
| + | l = 9 | ||
| + | |||
| + | While born < #1/1/2021# | ||
| + | born = DateAdd("yyyy", 1, born) | ||
| + | l = l + 1 | ||
| + | If born >= #1/1/2000# Then | ||
| + | Set o = r.GetOccurrence(born) | ||
| + | o.Location = l & " let" ' (" & DatePart("yyyy", a.Start) & ")" | ||
| + | o.Save | ||
| + | End If | ||
| + | Wend | ||
| + | | ||
| + | End If | ||
| + | Next i | ||
| + | End Sub | ||
| + | </code> | ||
| + | |||
| + | ===== PowerPoint ===== | ||
| + | ==== Export/import animací cest ==== | ||
| + | <code> | ||
| + | Public Const FilePath As String = "I:\Desktop\paths.txt" | ||
| + | |||
| + | Public Sub ExportCurrentSlidePaths() | ||
| + | |||
| + | Dim s As Slide | ||
| + | Dim e As Effect | ||
| + | Dim b As AnimationBehavior | ||
| + | |||
| + | Dim eI As Integer | ||
| + | Dim bI As Integer | ||
| + | |||
| + | Set s = Application.ActiveWindow.View.Slide | ||
| + | |||
| + | Open FilePath For Output As #1 | ||
| + | |||
| + | eI = 1 | ||
| + | For Each e In s.TimeLine.MainSequence | ||
| + | bI = 1 | ||
| + | | ||
| + | For Each b In e.Behaviors | ||
| + | Debug.Print eI & vbTab & bI & vbTab & b.MotionEffect.Path & vbTab & e.DisplayName | ||
| + | Print #1, eI & vbTab & bI & vbTab & b.MotionEffect.Path & vbTab & e.DisplayName | ||
| + | bI = bI + 1 | ||
| + | Next b | ||
| + | | ||
| + | eI = eI + 1 | ||
| + | Next e | ||
| + | |||
| + | Close #1 | ||
| + | |||
| + | End Sub | ||
| + | |||
| + | Public Sub ImportCurrentSlidePaths() | ||
| + | |||
| + | Dim line As String | ||
| + | Dim tokens() As String | ||
| + | |||
| + | Dim eI As Integer | ||
| + | Dim bI As Integer | ||
| + | Dim motionPath As String | ||
| + | |||
| + | Open FilePath For Input As #1 | ||
| + | While Not EOF(1) | ||
| + | Line Input #1, line | ||
| + | |||
| + | tokens = Split(line, vbTab) | ||
| + | eI = CInt(tokens(0)) | ||
| + | bI = CInt(tokens(1)) | ||
| + | motionPath = tokens(2) | ||
| + | |||
| + | Application.ActiveWindow.View.Slide.TimeLine.MainSequence(eI).Behaviors(bI).MotionEffect.Path = motionPath | ||
| + | Wend | ||
| + | |||
| + | Close #1 | ||
| + | |||
| End Sub | End Sub | ||
| </code> | </code> | ||
| Řádek 145: | Řádek 241: | ||
| Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal path As String) As Long | Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal path As String) As Long | ||
| </code> | </code> | ||
| + | |||
programovani/vba.txt · Poslední úprava: 24.05.2016 19:25 autor: vm