تطبيقات الفيجوال بيسك في Microsoft Office

إعداد الدكتور / محمود بدر

مقدمة :

فرونت بيج FrontPage

فيجوال بيسك وورد Word :

مزيد من ماكروات Macros ورد Word :

إكسل Excel

التعامل من داخل فيجوال بيسك مع برامج التطبيقات

مقدمة :

ظلت فيجوال بيسك للتطبيقات VBA لسنوات عدة اللغة المستخدمة مع مايكروسوفت أوفس M. Office ، فهي لغة بسيطة تتيح للمبرمجين ، والمستخدمين المحترفين تنفيذ ما يلي :

1- توسيع تطبيقات أوفس و جعلها آلية .

2- تكامل تطبيقات أوفس M. Office ، وإمكانية تبادل البيانات بين تطبيقات أوفس M. Office مثل تبادل البيانات بين اكسل Excel و ورد word .

والفكرة هي من خلال إنشاء لغة عامة ، وبيئة برمجة لعدد من التطبيقات ، بحيث يمكن للأفراد أن يخصصوا تطبيقات معينة ، ويضيفوا مقدرات جديدة للتطبيق.

فرونت بيج FrontPage

1- انقر قائمة أدوات Tool واختر Macros.. .

2- سوف تظهر لك النافذة التالية :

أكتب bbb فيظهر الزر Create انقره سوف يفتح لك محرر فيجوال بيسك

ملحوظة : اتبع الخطوات بدقة لتجنب أخطاء .

3- وبعد فتح محرر فيجوال بيسك ، ابحث عن الإجراء bbb و أدخل الشفرة التالية :

Sub bbb() 'اسم الماكرو

'التأكد من أن الصفحة مرئية وأنه مفتوح صفحة واحدة علي الأقل

If (Application.ActiveWebWindow.ViewMode = fpWebViewPage _

And ActiveWebWindow.PageWindows.Count > 0) Then Dim activePage, page As PageWindow 'Declare variables

'ضبط المتغير ActivePage علي الصفحة الحالية

'current active page

Set activePage = ActivePageWindow

'Loop through all open pages

For Each page In ActiveWebWindow.PageWindows page.Activate

'Click the Save button for each page

CommandBars("Add Command").Controls("&File"). _

Controls("&Save").Execute

Next

'Display the page you were working on when

'the Save All command was clicked

activePage.Activate

End If

End Sub

4- عد إلي فرونت بيج ، ومن قائمة Tool اختر Customize .

علي الفور سوف تظهر لك النافذة التالية :

5- اختر التبويب Commandf واختر Macross ، من الخانة اليمني اسحب العنوان Custom New Item بالماوس وضعه علي شريط الأدوات أو في قائمة File .

6- انقر Custom New Item في الموضع الذي وضعته فيه ، سوف يظهر الزر Modify Selection و غير الاسم إلي حفظ الكل

7- انقر الزر Modify Selection مرة أخري واختر تخصيص ماكرو Asign Macro .

سوف تظهر لك النافذة التالية :

انقر الزر OK

8- انقر الزر Close

الآن يظهر في شريط القائمة الأمر احفظ الكل ، وهو يهدف إلي حفظ كل صفحات الفرونت بيج Front Page المفتوحة مما يسهل عليك بدلاً من حفظها فرادي .

بنفس الخطوات السابقة أنشئ الماكروز Macros التالي :

Sub aaa()

Shell "D:\Program Files\Common Files\Microsoft Shared\PhotoEd\Photoed.exe"

End Sub

Sub ccc()

Shell "C:\WIN98\Pbrush.exe"

End Sub

فيجوال بيسك وورد Word :

1- من قائمة أدوات انقر ماكرو ، ومن القائمة الفرعية اختر تسجيل ماكرو جديد :

وهنا سوف تظهر لك النافذة التالية :

انقر الزر موافق .

سوف يظهر لك الشكل التالي :

وهي علامة بدء تسجيل الماكرو

2- انقر قائمة أدوات مرة أخري واختر ماكرو Macro

سوف تنبثق لك النافذة التالية :

انقر الزر تحرير وهنا سوف يظهر لك محرر فيجوال بيسك

اكتب ما يلي :

Shell "C:\MSWLogo\logo.exe"

أو أي مسار لملف تنفيذي .

3- الآن انقر قائمة أدوات مرة أخري واختر تخصيص ثم انقر الزر أوامر Commands

اسحب اسم الماكرو Macro إلي أعلي وضعه في شريط القوائم أو آي شريط أدوات

ثم اضغط الزر تغيير التحديد

وأشر علي نمط افتراضي

ثم اختر تحرير شكل الزر وسوف يظهر لك محرر شكل الزر كما يلي :

انقر الزر موافق و سوف تري علي شريط الأدوات وفي الموضع الذي سبق أن وضعت فيه اسم الماكرو Macro الاسم الجديد وهو لغة اللوجو

الآن يمكنك أن تدرج نفس الماكرو Macro المذكور في فرونت بيج Front Page في ورد . هل يعمل بنفس الطريقة مع ضرورة تنفيذ الخطوات السابقة بالترتيب .

حاول أن تجرب تنفيذ عدة ملفات تنفيذية مثل القاموس وغيره .

من الواضح أن تطبيق فيجوال بيسك يهدف كما سبق أن ذكرنا إلي تقليل الوقت المستهلك في تنفيذ المهام الروتينية ، والمثال التالي يوضح بعض من المهام الروتينية التي نقوم بتنفيذها في ورد Word فمثلاً :

لنفرض أنك تقوم بالمهام التالية عند بدء إنشاء وثيقة جديدة :

1- نظلل كل الوثيقة .

2- نختار الخط Arabic Transparent .

3- نختار حجم الخط 14 .

4- تنسيق الوثيقة من الطرفين .

ولكي تسهل الأمر يمكنك أن تقوم بتلك المهام من خلال ماكرو Macro كما يلي :

1- من قائمة أدوات اختر ماكرو Macro ثم تسجيل ماكرو Macro جديد .

2- انقر موافق ثم :

أ- ظلل كل الوثيقة بلمس المفتاحين Ctrl + A .

ب-اختر الخط Arabic Transparent .

ت-اختر حجم الخط 14 .

ث-انقر التنسيق من الطرفين

3- انتقل إلي قائمة الأدوات مباشرة ثم اختر ماكرو Macro واختر إيقاف تسجيل ماكرو Macro .

4- انتقي تخصيص من قائمة الأدوات واختر الأوامر ثم اختر ماكرو Macro واسحب اسم الماكرو Macro الذي تم تسجيله إلي شريط الأدوات واختر افتراضي ثم غير الاسم لروتين بنفس الطريقة السابقة ، وعموما سوف تجد أن ورد Word قد سجل لك الماكرو Macro التالي :

Sub ماكرو4()

'

' ماكرو4 ماكرو

' تسجيل الماكرو 27/09/00 من قبل د. محمود إبراهيم محمد بدر'

Selection.WholeStory Selection.Font.NameBi = "Arabic Transparent"

Selection.Font.SizeBi = 14

Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify

End Sub

هل يمكنك أن تجعل الماكرو Macro يظلل منطقة محددة ويكرر ما سبق عليها .

أضف السطر التالي في نهاية الماكرو Macro :

MsgBox “تم التنفيذ يا صديق”

وقبل أن نواصل عليك اتباع الخطوات بدقة لأن الماكرو Macro قد ينفذ أشياء غير متوقعة .

أحياناً نريد طريقة سريعة لرسم الجداول مباشرة جرب الماكرو Macro التالي :

Sub 1MyOwnTable()

Dim iRow as integer ,iColumns as integer

Dim myTable

IRows=InputBox(“أدخل عدد صفوف الجدول”)

Icolumns=InputBox(“أدخل عدد الأعمدة”)

If iRow >1 and iColumns >1 Then set myTable=ActiveDocument.Tables.Add(Selection.Range,Irows,Icolumns) ‘يجب أن يكون عدد الصفوف والأعمدة أكبر من 2

Mytable.AutoFormat Format:=wdTableFormateColorful2 Else

MsgBox “يجب أن يحتوي الجدول علي صفين وعمودين علي الأقل”

EndIF

End Sub

تغيير فهرس أو المسار :

Sub تغيير_المجلد()

Dim MyPath as String

MyPath=InputBox(“أكتب مسار المجلد المطلوب”)

Application.ChangeFileOpenDirectory (“C:\&MyPath)

End Sub

عمل نسخ احتياطية من الملفات

Sub نسخة_احتياطية()

Dim backupFile as String

Dim CurrFile as String

With ActiveDocument

If .Saved Or .Path=”” Then Exit Sub

.Bookmarks.Add Name:=”Last”

Application.ScreenUpdating=False

.Save

CurrFile=.FullName

BackupFile=”A:\”+.Name

.Save As FileName:=backupFile

End With

ActiveDocument.Close

Document.Open FileName:=CurrFile

ActiveDocument.GoTo what:=wdGoToLine,

Which:=wdGoTo what:=wdGoToBookmark, Name:=”Last”

End Sub

مزيد من ماكروات Macros ورد Word :

Sub CollectCaptions()

'

' This macro collects all figure captions in the text

' and appends them to the document.

' Captions are formatted with the Caption style, which is

' used to locate them in the text

Dim CaptionsText As String

' Move to beginning of document

Selection.HomeKey Unit:=wdStory

' Set up the Find & Replace dialog box's psrameters

Selection.Find.ClearFormatting

Selection.Find.Style = ActiveDocument.Styles("Caption")

With Selection.Find

.Text = ""

.Replacement.Text = ""

.Forward = True

' .Wrap = wdFindAsk

.Format = True

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

' Now execute the Find operation

Selection.Find.Execute

CaptionsText = CaptionsText & Selection.Text

If (Not Selection.Find.Found) Or Selection.End Then

FindMore = False

End If

FindMore = True

' Repeat the Fid operation as long as there are more instances

' of the text being searched

While FindMore

Selection.Find.Execute

' Stop searching if last find operation was not successful

CaptionsText = CaptionsText & Selection.Text

If (Not Selection.Find.Found) Then

FindMore = False

End If

Wend

' Insert spaces before the list of captions

CaptionsText = vbCrLf & vbCrLf & vbCrLf & "L I S T O F C A P T I O N S" & vbCrLf & CaptionsText

' Append list of captions to text

Selection.EndKey Unit:=wdStory

Selection.Text = CaptionsText

' Set Normal style, or else it may be formatted in the

' document's last paragraph's style

Selection.Style = "Normal"

End Sub

إكسل Excel

يوفر برنامج إكسل Excel مجموعة من كائنات Com ، مثل Application ، و Sheet ، و Workbook ، ويمكن للمبرمج إنشاء هذه العناصر داخل برنامجه ، ثم استخدامها كوسيلة للوصول إلي جميع خدمات البرنامج .

مثال (1) :

شغل برنامج إكسل Excel ومن قائمة أدوات انتقي ماكرو Macro ثم تسجيل ماكرو Macro جديد :

علي الفور تظهر لك النافذة التالية :

انقر الزر موافق

2 – انتقي من قائمة أدوات ماكرو Macro ثم وحدات الماكرو Macro :

علي الفور تظهر لك نافذة تحوي بالماكروات Macros الموجودة .

انقر تحرير وضع في المحرر الشفرة التالية :

Sub ماكرو1()

'

' ماكرو1 ماكرو

' الماكرو مسجل 28/09/2000 بواسطة د. محمود إبراهيم محمد بد'

'

10 Dim App As Excel.Application

20 Dim Book As Excel.Workbook

30 Dim Sheet As Excel.Worksheet

'انشاء تطبيق اكسل

40 Set App = CreateObject("Excel.application")

'جعل تطبيق إكسل مرئي

50 App.Visible = True

'إنشاء work book خالي

60 Set Book = App.Workbooks.Add

70 Set Sheet = Book.Worksheets(1)

'وضع نص في الخلية A1

80 Sheet.Cells(1, 1).Value = "هذه هي الخلية A1"

'وضع نص في الخلية A2

90 Sheet.Cells(2, 1).Value = "هذه هي الخلية A2"

100 Sheet.Cells(2, 1).Font.Color = vbBlue

End Sub

الآن انتقل إلي إكسل Excel ، ومن قائمة أدوات انتقي تخصيص ثم أوامر ثم وحدات ماكرو Macro كما بالنافذة التالية :

اسحب عنصر قائمة مخصص إلي شريط الأدوات ثم انقر تعديل التحديد فتظهر النافذة التالية :

بعد انتقاء تعيين ماكرو Macro تظهر لك النافذة التالية :

اضغط موافق ، والآن ربما ترغب في تقليل حجم النص الذي يشير لاسم الماكرو Macro وهو عنصر قائمة جديد ، انقر تعديل التحديد و إلي الاسم اكتب تجربة

الآن أغلق النافذة وسوف تجد زر في شريط الأدوات يحمل اسم تجربة ، وهنا أصبح الماكرو Macro جاهزاً انقر الماكرو Macro تجربة تحصل علي الشكل التالي :

مزيد من الماكروات Macros :

' To uncomment the following declaration

' first add a reference to the Excel 8.0 Object Library

'Public appExcel As Excel.Application

Public appExcel As Object

Sub main()

On Error Resume Next

Set appExcel = GetObject(App.Path & "\FRMSales.xls", "Excel.Application")

If appExcel Is Nothing Then

Set appExcel = CreateObject("Excel.Application")

appExcel.Workbooks.Open App.Path & "\FRMSales.xls"

End If

VBEXCEL.Show

End Sub

مثال :

لنفرض اننا نريد أن ننشئ جدول للضرب

استخدم الشفرة التالية :

Sub ماكرو1()

'

' ماكرو1 ماكرو

' الماكرو مسجل 28/09/2000 بواسطة د. محمود إبراهيم محمد بد'

'

10 Dim app As Excel.Application

20 Dim book As Excel.Workbook

30 Dim sheet As Excel.Worksheet

'إنشاء هدف في إكسل

40 Set app = CreateObject("Excel.Application")

'إنشاء كتاب عمل خاوي

50 Set book = app.Workbooks.Add

'الحصول علي إسناد للشيت الأول في كتاب العمل

60 Set sheet = book.Worksheets(1)

'ملئ العمود الأيسر من الجدول

70 Dim row As Integer

80 For row = 1 To 10

90 sheet.Cells(row + 1, 1).Value = row

100 Next row

'ملئ الصف العلوي من الجدول

110 Dim col As Integer

120 For col = 1 To 10

130 sheet.Cells(1, col + 1).Value = col

140 Next col

'ملئ خلايا الجدول

150 For row = 1 To 10

160 For col = 1 To 10

170 sheet.Cells(row + 1, col + 1).Value = row * col

180 Next col

190 Next row

'تغيير الألوان

200 sheet.Range("A1", "K1").Interior.Color = &HC0C000

210 sheet.Range("A1", "A11").Interior.Color = &HC0C000

220 sheet.Range("B2", "K11").Interior.Color = &HFFC0C0

'ضبط العمود الأيسر والأعلي علي الخط الغامق

230 sheet.Range("A1", "K1").Font.Bold = True

240 sheet.Range("A1", "A11").Font.Bold = True

'جعل تطبيق اكسل مرئيا

250 app.Visible = True

260 sheet.SaveAs "c:\test.xls"

End Sub

سوف يكون الناتج كما يلي :

التعامل من داخل فيجوال بيسك مع برامج التطبيقات

مشروع :

ابدأ مشروع جديد ، وضع عليه 6 أزرار أوامر } Command Buttons كما يلي :

غير الخاصية Caption لأزرار الأوامر كما يلي :

القيمة	الخاصية	الزر
برنامج إكسل Excel	Caption	Command1
True	RightToLeft
Arabic Transparent Size =12	Font
برنامج ورد Word	Caption	Command2
Arabic Transparent Size =12	Font
True	RightToLeft
فتح صفحة عمل جديدة	Caption	Command3
Arabic Transparent Size =12	Font
True	RightToLeft
فتح وثيقة جديدة	Caption	Command4
Arabic Transparent Size =12	Font
True	RightToLeft
إنها صفحة العمل الجديدة	Caption	Command5
Arabic Transparent Size =12	Font
True	RightToLeft
إنهاء الوثيقة الجديدة	Caption	Command6
Arabic Transparent Size =12	Font
True	RightToLeft
حساب قيمة تعبير رياضي	Caption	Command7
Arabic Transparent Size =12	Font
True	RightToLeft
خروج	Caption	Command8
Arabic Transparent Size =12	Font

وسوف تبدو نافذة المشروع كما يلي :

Option Explicit

Dim AppWord As Word.Application

Dim AppExcel As Excel.Application

Private Sub Command1_Click()

Screen.MousePointer = vbHourglass

Set AppExcel = CreateObject("Excel.Application")

Screen.MousePointer = vbDefault

Command3.Enabled = True

Command5.Enabled = True

Command8.Enabled = True

End Sub

Private Sub Command2_Click()

Screen.MousePointer = vbHourglass

Set AppWord = CreateObject("Word.Application")

Screen.MousePointer = vbDefault

Command4.Enabled = True

Command6.Enabled = True

End Sub

Private Sub Command3_Click()

Dim wSheet As Worksheet

Dim wBook As Workbook

If AppExcel.Workbooks.Count = 0 Then

Debug.Print "إضافة ورقة عمل جديدة"

Set wBook = AppExcel.Workbooks.Add

End If

Set wSheet = AppExcel.Sheets(1)

wSheet.Cells(2, 1).Value = "الربع الأول"

wSheet.Cells(2, 2).Value = "الربع الثاني"

wSheet.Cells(2, 3).Value = "الربع الثالث"

wSheet.Cells(2, 4).Value = "الربع الرابع"

wSheet.Cells(3, 1).Value = 123.45

wSheet.Cells(3, 2).Value = 435.56

wSheet.Cells(3, 3).Value = 376.25

wSheet.Cells(3, 4).Value = 425.75

Range("A2:D2").Select

With Selection.Font

.Name = "Verdana"

.FontStyle = "Bold"

.Size = 12

End With

Range("A3:D3").Select

With Selection.Font

.Name = "Arabic Transparent"

.FontStyle = "Regular"

.Size = 11

End With

Range("A2:D2").Select

Selection.Columns.AutoFit

Selection.ColumnWidth = Selection.ColumnWidth * 1.25

Range("A2:E2").Select

With Selection

.HorizontalAlignment = xlCenter

End With

AppExcel.Visible = True

End Sub

Private Sub Command4_Click()

Dim wDoc As Document

Dim tmpText As String

Dim parCount As Long, wordCount As Long, charCount As Long

Dim msg As String

If AppWord.Documents.Count = 0 Then

AppWord.Documents.Add

End If

AppWord.Documents(1).Range.InsertAfter "عنوان الوثيقة" & vbCr

AppWord.Documents(1).Range.Font.Bold = True

AppWord.Documents(1).Range.Font.Size = 16

AppWord.Documents(1).Range.Font.Name = "Arabic Transparent"

AppWord.Documents(1).Range.InsertAfter "هذه الوثيقة تمثل أول فقرة في الوثيقة وهي منسقة من اليسار فقط" & vbCr

AppWord.Documents(1).Range.InsertAfter "وهذه هي الفقرة الثانية من الوثيقة "

AppWord.Documents(1).Range.InsertAfter "وتم إدخالها بالجملة التالية : "

AppWord.Documents(1).Range.InsertAfter "AppWord.Documents(1).Range.InsertAfter " & vbCr

AppWord.Documents(1).Range.InsertAfter "والفقرة منسقة من جهة اليسار أيضاً" & vbCrLf

parCount = AppWord.Documents(1).Paragraphs.Count

wordCount = AppWord.Documents(1).Words.Count

charCount = AppWord.Documents(1).Characters.Count

msg = "هذه الوثيقة تحوي " & vbCrLf

msg = msg & parCount & " فقرات" & vbCrLf

msg = msg & wordCount & " كلمات" & vbCrLf

msg = msg & charCount & " حروف"

MsgBox msg

Debug.Print "إضافة وثيقة جديدة"

AppWord.Visible = True

AppWord.Documents(1).Paragraphs(1).Alignment = wdAlignParagraphCenter

End Sub

Private Sub Command5_Click()

AppExcel.DisplayAlerts = False

AppExcel.Quit

Command3.Enabled = False

Command5.Enabled = False

Command8.Enabled = False

End Sub

Private Sub Command6_Click()

On Error Resume Next

AppWord.DisplayAlerts = False

AppWord.Quit

Dim wRunning As String

wRunning = AppWord.Application.Name

If Error Then

Command4.Enabled = False

Command6.Enabled = False

End If

End Sub

Private Sub Command7_Click()

End

End Sub

Private Sub Command8_Click()

Dim wSheet As Worksheet

Dim wBook As Workbook

Dim expression

expression = InputBox("أدخل تعبير رياضي لحسابه (i.e., 1/cos(3.45)*log(19.004)")

If Trim(expression) <> "" Then

If AppExcel.Workbooks.Count = 0 Then

Debug.Print "إضافة ورقة عمل جديدة"

Set wBook = AppExcel.Workbooks.Add

End If

Set wSheet = AppExcel.Sheets(1)

On Error GoTo CalcError

wSheet.Cells(1, 1).Value = "=" & expression

wSheet.Calculate

MsgBox "قيمة التعبير " & expression & vbCrLf & " هي " & wSheet.Cells(1, 1).Value

End If

Exit Sub

CalcError:

MsgBox "خطأ في حساب التعبير الرياضي"

End Sub

Private Sub Form_Terminate()

Set AppExcel = Nothing

Set AppWord = Nothing

End Sub

مقدمة :

فرونت بيج FrontPage

فيجوال بيسك وورد Word :

مزيد من ماكروات Macros ورد Word :

إكسل Excel

التعامل من داخل فيجوال بيسك مع برامج التطبيقات

صفحة البداية

صفحة التطبيقات

أعلي الصفحة

---

1 PC Magazine ,vol 5,Issue 6,1999 (Arabic version) ,Page 82