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 Poslední revize Obě strany příští revize | ||
programovani:vba [24.06.2014 11:06] miloush [Trim] |
programovani:vba [24.05.2016 19:24] vm |
||
---|---|---|---|
Řádek 1: | Řádek 1: | ||
====== VBA ====== | ====== VBA ====== | ||
+ | ===== Excel ===== | ||
+ | * [[vba/excel-tabulky]] | ||
+ | |||
===== Vstup ===== | ===== Vstup ===== | ||
==== Seznam povolených klávesnic ==== | ==== Seznam povolených klávesnic ==== | ||
Řádek 107: | Řádek 110: | ||
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 244: | ||
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