ابو اسامة العينبوسي قام بنشر أبريل 23, 2007 مشاركة قام بنشر أبريل 23, 2007 السلام عليكم http://www.vba-programmer.com/#ExcelBkmk رابط هذا التعليق شارك More sharing options...
mehyo27 قام بنشر أبريل 23, 2007 مشاركة قام بنشر أبريل 23, 2007 جزاك الله كل خير رابط هذا التعليق شارك More sharing options...
محمد عسكر قام بنشر أبريل 23, 2007 مشاركة قام بنشر أبريل 23, 2007 السلام عليكم أخى الفاضل / ابو اسامة شكرا شكرا شكرا شكرا بارك الله فيك جزاك الله خيرا تحياتى رابط هذا التعليق شارك More sharing options...
gamalin قام بنشر أبريل 23, 2007 مشاركة قام بنشر أبريل 23, 2007 جميل جدا ومفيد للمجتهدين الغاوين البحث والتعلم رائع رابط هذا التعليق شارك More sharing options...
نزار سليمان عيد قام بنشر أبريل 24, 2007 مشاركة قام بنشر أبريل 24, 2007 اخي ابواسامة تشكر على هذا الموقع وجزاك اله خيرا تحياتي رابط هذا التعليق شارك More sharing options...
ابو اسامة العينبوسي قام بنشر أبريل 24, 2007 الكاتب مشاركة قام بنشر أبريل 24, 2007 (معدل) السلام عليكم هذا كود من الموقع المذكور يقوم باضافة الموديل برمجيا يعني برمجه بالبرمجه لكن للاسف ليس دائما استطيع ادراج النص ككود ADD Module programmaticly Public Sub Main() ' See if there's a module already there For Each c In ActiveWorkbook.VBProject.VBComponents If (c.Properties("Name") = ActiveSheet.Name) Then Set WBCodeMod = c.CodeModule End If Next ' Count the lines in the module LineCount = WBCodeMod.CountOfLines ' If so delete them ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook._ ActiveSheet.CodeName).CodeModule.DeleteLines 1, LineCount ' Adding code programatically ActiveWorkbook.VBProject._ VBComponent(ActiveWorkbook.ActiveSheet.CodeName).CodeModule.AddFromString _ "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCr & _ "Dim iColor As Integer" & vbCr & _ "On Error Resume Next" & vbCr & _ "iColor = Target.Interior.ColorIndex" & vbCr & _ "If iColor < 0 Then" & vbCr & _ " iColor = 36" & vbCr & _ "Else" & vbCr & _ " iColor = iColor + 1" & vbCr & _ "End If" & vbCr & _ "If iColor = Target.Font.ColorIndex Then iColor = iColor + 1" & vbCr & _ "Cells.FormatConditions.Delete" & vbCr & _ "With Range(""A"" & Target.Row, Target.Address) " & vbCr & _ " .FormatConditions.Add Type:=2, Formula1:=""TRUE""" & vbCr & _ " .FormatConditions(1).Interior.ColorIndex = iColor" & vbCr & _ "End With" & vbCr & _ "With Range(Target.Offset(1 - Target.Row, 0).Address & _ "":"" & Target.Offset(-1, 0).Address)" & vbCr & _ " .FormatConditions.Add Type:=2, Formula1:=""TRUE""" & vbCr & _ " .FormatConditions(1).Interior.ColorIndex = iColor" & vbCr & _ "End With" & vbCr & _ "End Sub" تم تعديل أبريل 24, 2007 بواسطه ابو اسامة العينبوسي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.