Word 2000. Руководство разработчика

  • Published on
    08-Dec-2016

  • View
    218

  • Download
    3

Embed Size (px)

Transcript

Vord2000_Developers_Handbuok/Book.clsVERSION 1.0 CLASSBEGIN MultiUse = -1 'TrueENDAttribute VB_Name = "Book"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseOption Explicit

Const bookName = "Book Project"

Dim bookTitle As StringDim bookAuthor As StringDim bookPages As LongDim bookPrice As CurrencyDim bookPublicationDate As DateDim bookAvailable As Boolean

Property Let Title(strT As String) bookTitle = strTEnd Property

Property Get Title() As String Title = bookTitleEnd Property

Property Let Author(strA As String) bookAuthor = strAEnd Property

Property Get Author() As String Author = bookAuthorEnd Property

Property Let Pages(lngP As Long) bookPages = PagesEnd Property

Property Get Pages() As Long Pages = bookPagesEnd Property

Property Let Price(curP As Currency) bookPrice = curPEnd Property

Property Get Price() As Currency Price = bookPriceEnd Property

Property Let PublicationDate(dtePD As Date) bookPublicationDate = dtePDEnd Property

Property Get PublicationDate() As Date PublicationDate = bookPublicationDateEnd Property

Property Get Available() As Boolean Available = Date >= PublicationDateEnd Property

Sub ShowInfo() Dim strM As String strM = "Title:" & vbTab & bookTitle & vbCr strM = strM & "Author:" & vbTab & bookAuthor & vbCr strM = strM & "Pages:" & vbTab & bookPages & vbCr strM = strM & "Price:" & vbTab & "$" & bookPrice & vbCr strM = strM & "Date:" & vbTab & Me.PublicationDate & vbCr If Me.Available Then strM = strM & vbCr & "AVAILABLE NOW" MsgBox strM, vbOKOnly + vbInformation, bookName _ & " Information"End Sub

Vord2000_Developers_Handbuok/frmCreateFolders.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmCreateFolders Caption = "Create Folders" ClientHeight = 2385 ClientLeft = 45 ClientTop = 330 ClientWidth = 3975 OleObjectBlob = "frmCreateFolders.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmCreateFolders"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption Explicit

Private Sub cmdCancel_Click() frmCreateFolders.Hide Unload frmCreateFolders EndEnd Sub

Private Sub cmdOK_Click() Dim strMsg As String Dim strFolderName As String Dim i As Integer frmCreateFolders.Hide Unload frmCreateFolders strMsg = "The Create_Folders procedure has created " _ & "the following folders: " & vbCr & vbCr For i = 1 To txtHowManyFolders.Value If i < 10 Then strFolderName = txtISBN.Value & "c0" & i Else strFolderName = txtISBN.Value & "c" & i End If MkDir strFolderName strMsg = strMsg & " " & strFolderName & vbCr Next i MsgBox strMsg, vbOKOnly + vbInformation, _ "Create Folders"End Sub

Vord2000_Developers_Handbuok/frmCreateFolders.frxVord2000_Developers_Handbuok/frmCreateFoldersAndSubfolders.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmCreateFoldersAndSubfolders Caption = "Create Folders and Subfolders" ClientHeight = 2175 ClientLeft = 45 ClientTop = 330 ClientWidth = 3450 OleObjectBlob = "frmCreateFoldersAndSubfolders.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmCreateFoldersAndSubfolders"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub cmdOK_Click() frmCreateFoldersAndSubfolders.Hide Unload frmCreateFoldersAndSubfolders StartingFolder = CurDir For i = 1 To txtHowManyFolders.Value If i < 10 Then FolderName = txtISBN.Value & "c0" & i Else FolderName = txtISBN.Value & "c" & i End If MkDir FolderName ChDir FolderName For Subfolder = 1 To txtHowManySubfolders.Value SubfolderName = "Section" & Subfolder MkDir SubfolderName Next Subfolder ChDir StartingFolder Next iEnd Sub

Private Sub cmdCancel_Click() EndEnd Sub

Vord2000_Developers_Handbuok/frmCreateFoldersAndSubfolders.frxVord2000_Developers_Handbuok/frmDataSurfer2000.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmDataSurfer2000 Caption = "DataSurfer2000" ClientHeight = 6150 ClientLeft = 45 ClientTop = 330 ClientWidth = 5430 OleObjectBlob = "frmDataSurfer2000.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmDataSurfer2000"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False

Private Sub cmdAddRecord_Click() ActiveDocument.Tables(1).Rows(ActiveDocument.Tables(1).Rows.Count).Select Selection.InsertRowsBelow 1 'and add a tab to the tab strip 'this isn't working yet tabSurfer.Tabs.Add , Index:=tabSurfer.Tabs.Count + 1End Sub

Private Sub cmdClose_Click() 'update all the records? EndEnd Sub

Private Sub tabSurfer_Change() UpdateDataSurferEnd Sub

Sub UpdateDataSurfer() With ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) txtFirstName.Text = Left(.Cells(1).Range.Text, _ Len(.Cells(1).Range.Text) - 2) txtInitial.Text = Left(.Cells(2).Range.Text, _ Len(.Cells(2).Range.Text) - 2) txtLastName.Text = Left(.Cells(3).Range.Text, _ Len(.Cells(3).Range.Text) - 2) txtAddress1.Text = Left(.Cells(4).Range.Text, _ Len(.Cells(4).Range.Text) - 2) txtAddress2.Text = Left(.Cells(5).Range.Text, _ Len(.Cells(5).Range.Text) - 2) txtCity.Text = Left(.Cells(6).Range.Text, _ Len(.Cells(6).Range.Text) - 2) txtState.Text = Left(.Cells(7).Range.Text, _ Len(.Cells(7).Range.Text) - 2) txtZip.Text = Left(.Cells(8).Range.Text, _ Len(.Cells(8).Range.Text) - 2) txtHomeArea.Text = Left(.Cells(9).Range.Text, _ Len(.Cells(9).Range.Text) - 2) txtHomePhone.Text = Left(.Cells(10).Range.Text, _ Len(.Cells(10).Range.Text) - 2) txtWorkArea.Text = Left(.Cells(11).Range.Text, _ Len(.Cells(11).Range.Text) - 2) txtWorkPhone.Text = Left(.Cells(12).Range.Text, _ Len(.Cells(12).Range.Text) - 2) txtWorkExtension.Text = Left(.Cells(13).Range.Text, _ Len(.Cells(13).Range.Text) - 2) txtEmail.Text = Left(.Cells(14).Range.Text, _ Len(.Cells(14).Range.Text) - 2)

End WithEnd SubPrivate Sub txtFirstName_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(1).Range.Text = txtFirstName.TextEnd SubPrivate Sub txtInitial_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(2).Range.Text = txtInitial.TextEnd SubPrivate Sub txtLastName_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(3).Range.Text = txtLastName.TextEnd SubPrivate Sub txtAddress1_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(4).Range.Text = txtAddress1.TextEnd SubPrivate Sub txtAddress2_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(5).Range.Text = txtAddress2.TextEnd SubPrivate Sub txtCity_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(6).Range.Text = txtCity.TextEnd SubPrivate Sub txtState_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(7).Range.Text = txtState.TextEnd SubPrivate Sub txtZip_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(8).Range.Text = txtZip.TextEnd SubPrivate Sub txtHomeArea_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(9).Range.Text = txtHomeArea.TextEnd SubPrivate Sub txtHomePhone_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(10).Range.Text = txtHomePhone.TextEnd SubPrivate Sub txtWorkArea_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(11).Range.Text = txtWorkArea.TextEnd Sub

Private Sub txtWorkPhone_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(12).Range.Text = txtWorkPhone.TextEnd SubPrivate Sub txtWorkExtension_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(13).Range.Text = txtWorkExtension.TextEnd SubPrivate Sub txtEmail_Change() ActiveDocument.Tables(1).Rows(tabSurfer.Value + 2) _ .Cells(14).Range.Text = txtEmail.TextEnd Sub

Private Sub UserForm_Initialize() With ActiveDocument.Tables(1) 'add the right number of tabs to the tab strip For i = 2 To .Rows.Count tName = Left(.Rows(i).Cells(3).Range.Text, _ Len(.Rows(i).Cells(3).Range.Text) - 2) tabSurfer.Tabs.Add tName Next i 'load the contents of the first row onto the first tab With .Rows(2) txtFirstName.Text = Left(.Cells(1).Range.Text, _ Len(.Cells(1).Range.Text) - 2) txtInitial.Text = Left(.Cells(2).Range.Text, _ Len(.Cells(2).Range.Text) - 2) txtLastName.Text = Left(.Cells(3).Range.Text, _ Len(.Cells(3).Range.Text) - 2) txtAddress1.Text = Left(.Cells(4).Range.Text, _ Len(.Cells(4).Range.Text) - 2) txtAddress2.Text = Left(.Cells(5).Range.Text, _ Len(.Cells(5).Range.Text) - 2) txtCity.Text = Left(.Cells(6).Range.Text, _ Len(.Cells(6).Range.Text) - 2) txtState.Text = Left(.Cells(7).Range.Text, _ Len(.Cells(7).Range.Text) - 2) txtZip.Text = Left(.Cells(8).Range.Text, _ Len(.Cells(8).Range.Text) - 2) txtHomeArea.Text = Left(.Cells(9).Range.Text, _ Len(.Cells(9).Range.Text) - 2) txtHomePhone.Text = Left(.Cells(10).Range.Text, _ Len(.Cells(10).Range.Text) - 2) txtWorkArea.Text = Left(.Cells(11).Range.Text, _ Len(.Cells(11).Range.Text) - 2) txtWorkPhone.Text = Left(.Cells(12).Range.Text, _ Len(.Cells(12).Range.Text) - 2) txtWorkExtension.Text = Left(.Cells(13).Range.Text, _ Len(.Cells(13).Range.Text) - 2) txtEmail.Text = Left(.Cells(14).Range.Text, _ Len(.Cells(14).Range.Text) - 2) End With End WithEnd Sub

'create a CellText function to return the contents of'a cell without the end-of-cell character?

Vord2000_Developers_Handbuok/frmDataSurfer2000.frxVord2000_Developers_Handbuok/frmInventories.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmInventories Caption = "Inventories 2000" ClientHeight = 4485 ClientLeft = 45 ClientTop = 330 ClientWidth = 3990 OleObjectBlob = "frmInventories.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmInventories"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False

Private Sub UserForm_Initialize() frmInventories.Height = 120End Sub

Private Sub cmdMore_Click() If cmdMore.Caption = "More >>" Then cmdMore.Caption = ">" cmdMore.Accelerator = "M" End IfEnd Sub

Private Sub chkArtNames_Click() If chkArtNames = True Then optFromDocument.Enabled = True optFromDocument = True optAutoNames.Enabled = True Else optFromDocument.Enabled = False optFromDocument = False optAutoNames.Enabled = False optAutoNames = False End IfEnd Sub

Private Sub cmdOK_Click() frmInventories.Hide Unload frmInventories 'create inventories hereEnd Sub

Private Sub cmdCancel_Click() EndEnd Sub

Vord2000_Developers_Handbuok/frmInventories.frxVord2000_Developers_Handbuok/frmMeetingAnnouncement.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmMeetingAnnouncement Caption = "Meeting Announcement" ClientHeight = 3090 ClientLeft = 45 ClientTop = 330 ClientWidth = 4710 OleObjectBlob = "frmMeetingAnnouncement.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmMeetingAnnouncement"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False'Option Explicit

Private Sub cmdOK_Click() Unload frmMeetingAnnouncement MyText = "The " & cmbMeetingName.Value & _ " meeting will be held in the " _ & cmbMeetingLocation.Value & "." & vbCr _ & "The subject will be " _ & txtMeetingSubject.Text & "." Documents.Add Selection.TypeText Text:=MyText Selection.TypeParagraphEnd Sub

Private Sub UserForm_Initialize() cmbMeetingLocation.AddItem "Main conference room" cmbMeetingLocation.AddItem "Power conference room" cmbMeetingLocation.AddItem "Zen conference room" cmbMeetingName.AddItem "Strategy" cmbMeetingName.AddItem "Sales planning and marketing" cmbMeetingName.AddItem "Acquisitions and reductions" cmbMeetingName.AddItem "Review board considerations"End Sub

Private Sub cmdCancel_Click() EndEnd Sub

Vord2000_Developers_Handbuok/frmMeetingAnnouncement.frxVord2000_Developers_Handbuok/frmMoveCurrentParagraph.frmVERSION 5.00Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmMoveCurrentParagraph Caption = "Move Current Paragraph" ClientHeight = 3540 ClientLeft = 45 ClientTop = 330 ClientWidth = 3135 OleObjectBlob = "frmMoveCurrentParagraph.frx":0000 StartUpPosition = 1 'CenterOwnerEndAttribute VB_Name = "frmMoveCurrentParagraph"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub cmdOK_Click() frmMoveCurrentParagraph.Hide Unload frmMoveCurrentParagraph If chkReturnToPreviousPosition = True Then With ActiveDocument.Bookmarks .Add Range:=Selection.Range, _ Name:="Move_Paragraph_Temp" End With End If Selection.Extend Selection.Extend Selection.Extend Selection.Extend Selection.Cut If optUpOne = True Then Selection.MoveUp Unit:=wdParagraph, Count:=1 ElseIf optUpTwo = True Then Selection.MoveUp Unit:=wdParagraph, Count:=2 ElseIf optDownOne = True Then Selection.MoveDown Unit:=wdParagraph, Count:=1 Else Selection.MoveDown Unit:=wdParagraph, Count:=2 End If Selection.Paste If chkReturnToPreviousPosition = True Then Selection.GoTo What:=wdGoToBookmark, _ Name:="Move_Paragraph_Temp" ActiveDocument.Bookmarks("Move_Paragraph_Temp") _ .Delete End IfEnd Sub

Private Sub cmdCancel_Click() EndEnd Sub

Vord2000...

Recommended

View more >