TPE
![]() |
![]() |
![]() |
|
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
آنچه که در این نمونه به آن خواهیم پرداخت استفاده از یک Textbox از نوع Developer است.
![]() |
![]() |
در این پرزنتیشن، در اسلاید نخست اطلاعات ار کاربر دریافت می شود و در اسلاید دوم اطلاعات دریافت شده نمایش داده می شود و در صورت نیار چاپ می شود. |
کد ماکروی موجود در این پرزنتیشن به قرار زیر است:
Option Explicit
Dim gRayValues(1 To 100, 1 To 2) As String
Sub RecordAndProceed(oClickedSh As Shape)
' Records text entered on current slide
Dim x As Long
Dim oSh As Shape
Dim oSl As Slide
Dim bSearchMarkedOnly As Boolean
If ActivePresentation.Tags("SearchOnlyMarkedSlides") = "YES" Then
bSearchMarkedOnly = True
Else
bSearchMarkedOnly = False
End If
On Error Resume Next
For x = 1 To UBound(gRayValues)
If Len(gRayValues(x, 1)) = 0 Then
Exit For
End If
Next
For Each oSh In oClickedSh.Parent.Shapes
If oSh.Type = msoOLEControlObject Then
gRayValues(x, 1) = oSh.Name
gRayValues(x, 2) = oSh.OLEFormat.Object.Text
Debug.Print x & vbTab & gRayValues(x, 1) & vbTab & gRayValues(x, 2)
x = x + 1
End If
Next
' Find and replace text in presentation
' Assumes that each textbox control's name is txtXXXXX
' We'll replace all instances of %XXXXX% with contents of text box txtXXXXX
For Each oSl In ActivePresentation.Slides
' are we searching only marked slides?
If bSearchMarkedOnly Then
' is this slide marked?
If oSl.Tags("MarkedForSearch") = "YES" Then
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
With .TextFrame.TextRange
For x = 1 To UBound(gRayValues)
If InStr(.Text, "%" & Mid$(gRayValues(x, 1), 4) & "%") > 0 Then
If oSh.Tags("SAVED") <> "YES" Then
oSh.Tags.Add "SAVED", "YES"
oSh.Tags.Add "TEXT", .Text
End If
End If
.Text = _
Replace(.Text, _
"%" & Mid$(gRayValues(x, 1), 4) & "%", _
gRayValues(x, 2))
Next
End With ' textrange
End If
End If
End With
Next
End If
Else ' we're searching ALL slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
With .TextFrame.TextRange
For x = 1 To UBound(gRayValues)
If InStr(.Text, "%" & Mid$(gRayValues(x, 1), 4) & "%") > 0 Then
If oSh.Tags("SAVED") <> "YES" Then
oSh.Tags.Add "SAVED", "YES"
oSh.Tags.Add "TEXT", .Text
End If
End If
.Text = _
Replace(.Text, _
"%" & Mid$(gRayValues(x, 1), 4) & "%", _
gRayValues(x, 2))
Next
End With ' textrange
End If
End If
End With
Next
End If
Next ' Slide
SlideShowWindows(1).View.GotoSlide (oClickedSh.Parent.SlideIndex + 1)
End Sub
Sub Reset(oClickedSh As Shape)
Dim oSh As Shape
Dim x As Long
Dim oSl As Slide
' clear the text boxes on this slide
For Each oSh In oClickedSh.Parent.Shapes
If oSh.Type = msoOLEControlObject Then
oSh.OLEFormat.Object.Text = ""
End If
Next
' clear the array that holds values
For x = 1 To UBound(gRayValues)
gRayValues(x, 1) = ""
gRayValues(x, 2) = ""
Next
' restore the original text wherever there have been
' text substitutions
Call ResetSubstitutedText
End Sub
Sub PrintMe(oClickedSh As Shape)
' Prints current page to default printer
' Hides the print me button first
Dim oSl As Slide
Dim lSlRange As Long
oClickedSh.Visible = msoFalse
Set oSl = oClickedSh.Parent
lSlRange = oSl.SlideIndex
With ActivePresentation.PrintOptions
.RangeType = ppPrintSlideRange
With .Ranges
.ClearAll
.Add Start:=lSlRange, End:=lSlRange
End With
.NumberOfCopies = 1
.Collate = msoTrue
.OutputType = ppPrintOutputSlides
.PrintHiddenSlides = msoTrue
.PrintColorType = ppPrintColor
.FitToPage = msoTrue
.FrameSlides = msoFalse
End With
ActivePresentation.PrintOut
oClickedSh.Visible = msoTrue
End Sub
Sub MarkPresentationAsSearchOnlyMarked()
' Sets a presentation-wide option to search ONLY slides marked for search/replace
' in RecordAndProceed
' Once this is set, only slides "tagged" with MarkSlideForSearch below will be searched
' (normally we search all slides)
With ActivePresentation
.Tags.Add "SearchOnlyMarkedSlides", "YES"
End With
End Sub
Sub UNMarkPresentationAsSearchOnlyMarked()
' UNDoes the effect of MarkPresentationAsSearchOnlyMarked
With ActivePresentation
.Tags.Add "SearchOnlyMarkedSlides", ""
End With
End Sub
Sub MarkSlideForSearch()
' Marks a slide as a target for search and replace
' when the presentation is marked to search only these slides
Dim oSl As Slide
Dim x As Long
If ActiveWindow.Selection.Type = ppSelectionSlides Then
For x = 1 To ActiveWindow.Selection.SlideRange.Count
With ActiveWindow.Selection.SlideRange(x)
.Tags.Add "MarkedForSearch", "YES"
End With
Next
Else
MsgBox "Please select one or more slides then try again"
End If
End Sub
Sub UNMarkSlideForSearch()
' UNMarks a slide as a target for search and replace
Dim oSl As Slide
Dim x As Long
If ActiveWindow.Selection.Type = ppSelectionSlides Then
For x = 1 To ActiveWindow.Selection.SlideRange.Count
With ActiveWindow.Selection.SlideRange(x)
.Tags.Add "MarkedForSearch", ""
End With
Next
Else
MsgBox "Please select one or more slides then try again"
End If
End Sub
Sub ResetSubstitutedText()
Dim oSh As Shape
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.Tags("SAVED") = "YES" Then
oSh.TextFrame.TextRange.Text = oSh.Tags("TEXT")
oSh.Tags.Add "SAVED", "RESET"
End If
Next
Next
End Sub


پروژههای منتشر شده برای عموم (Published):
نمایش، ویرایش و چاپ متون فارسی تحت DOS در ویندوز
تبدیل متن فارسی داس به ویندوز اکسلTXLSx
نرم افزار ویرایش DSKKAR00 و DSKWOR00 لیست بیمه
حذف کاراکتر های جدولی از گزارش های تحت DOS
تبدیل متن و جداول گزارش های تحت DOS به Excel
چاپ فرم های ارزشیابی 100 امتیازی کارمندان
حضور و غیاب و موارد انضباطی (ماهناز)
کارنامه ماهانه توصیفی (ماهتوس)
حفاظت از برنامه نویسی در DOS تحت Windows با قفلگذاری روی Flash USB
حفاظت از پروژههای Autoplay Media Studio
حفاظت از پروژههای SetupFactory
حفاظت از پروژههای Multimedia Builder
تولید فایلهای EXE از فایل های PDF بدون امکان چاپ و ذخیره PDF to EXE (pdf2exe)
حفاظت از کدهاي برنامه نويسي شده در محيط VBA-Access
تغيير تصوير بک گراند صفحه ورود به Windows 7
بروزآوري آيکن هاي ويندوز Refresh Desktop Icons
فلوچارت و الگوریتم Flowgorithm
تکنیکهای ماکرونویسی در Powerpoint
نرم افزار نمایش محتوای فایل vcf به خصوص فایل های vcf موبایل
تغییر وضوح اسلاید پاورپوینت در استخراج با فرمت تصویر PNG و JPG
دانلود کد PHP نمایش آنلاین کارنامه های PDF
مرجع دانلود فایلهای CorelDraw
آموزش استفاده از #C برای به روزآوری دیتابیس(Database) یا بانک اطلاعاتی اکسس (Access)
![]() |
SMS Panel
|


