nooralhuda22 قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 السلام عليكم ورحمة الله وبركاته لدى مشكله لدي خليه بها ارقام تسلسليه ولكنى اريد عند الضغط عليها تظهرلى جميع البيانات الموجوده فى هذا الصف مثلا خلية الارقام اوريد اضغط عليها فتظهر جميع البيانات فى نفس الصف
سليم حاصبيا قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 اختي الفاضلة جربي هذا الملف (نموذج بسيط عما تريدينه) Select_data_by_columns.rar الكود فيما يعد لضعف النت الكود Sub Select_areas() Dim mY_rg As Range Dim last_col% Set mY_rg = Range("a2").CurrentRegion mY_rg.Interior.ColorIndex = 0 last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column ActiveCell.Resize(, last_col).Interior.ColorIndex = 6 End Sub '=================================================== Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False On Error Resume Next Dim rg As Range Set rg = Range("a2").CurrentRegion rg.Interior.ColorIndex = 0 If Target.Column <> 1 Or Target.Count > 1 Or Target = vbNullString Then GoTo 1 Select_areas 1: Application.EnableEvents = True On Error GoTo 0 End Sub ' 1
ظفر الله عسكر قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 جميل هل يمكن العمل على ان يكون عند تحديد خليه من الصف يلون كل الخلايا التي بها قيم في الصف شكرا استاذنا الفاضل الكود اليس موجود ضمن الملف _ المطور ؟؟؟
سليم حاصبيا قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 ت 32 دقائق مضت, ظفر الله عسكر said: جميل هل يمكن العمل على ان يكون عند تحديد خليه من الصف يلون كل الخلايا التي بها قيم في الصف شكرا استاذنا الفاضل الكود اليس موجود ضمن الملف _ المطور ؟؟؟ تغيير سطر واحد في الكود يقوم بهذا العمل Sub Select_areas() Dim mY_rg As Range Dim last_col% Set mY_rg = Range("a2").CurrentRegion mY_rg.Interior.ColorIndex = 0 last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column 'ActiveCell.Resize(, last_col).Interior.ColorIndex = 6 ActiveCell.Resize(, last_col).SpecialCells(xlCellTypeConstants, 23).Interior.ColorIndex = 6 End Sub '=================================================== Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False On Error Resume Next Dim rg As Range Set rg = Range("a2").CurrentRegion rg.Interior.ColorIndex = 0 If Target.Column <> 1 Or Target.Count > 1 Or Target = vbNullString Then GoTo 1 Select_areas 1: Application.EnableEvents = True On Error GoTo 0 End Sub 1
ظفر الله عسكر قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 شكرا جزيلا جزال الله خيرا نسخت الكود ولصقته بدل الموجود بقي كما هو هل انا اخطأت كنت اقصد اذا تم تحديد اية خليه بسطر يقوم بتحديد الخلايا التي تحتوي على قيم في هذا السطر جزاك الله كل خير
سليم حاصبيا قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 الملف مع التعديل 10 دقائق مضت, ظفر الله عسكر said: شكرا جزيلا جزال الله خيرا نسخت الكود ولصقته بدل الموجود بقي كما هو هل انا اخطأت كنت اقصد اذا تم تحديد اية خليه بسطر يقوم بتحديد الخلايا التي تحتوي على قيم في هذا السطر جزاك الله كل خير الملف مع التعديل Select_data_by_columns_1.rar 1
ظفر الله عسكر قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 شكرا جزيلا استاذي الغالي والكريم لعل التعبير خانني بالتوضيح الكود يعمل اذا تم تحديد خليه بالعمود a انا كنت اقصد اذا حددنا اية خليه بسطر ما وليس بالضروره في العمود الاول ان تتحدد باقي قيم السطر شكرا على سعة صدرك
سليم حاصبيا قام بنشر يناير 3, 2018 قام بنشر يناير 3, 2018 هذا الماكرو Option Explicit Sub Select_areas() Dim mY_rg As Range Dim last_col% Dim y% y = ActiveCell.Column Set mY_rg = Range("a2").CurrentRegion last_col = Cells(ActiveCell.Row, Columns.Count).End(1).Column With ActiveCell If last_col = 1 Then .Interior.ColorIndex = 6 .Borders.LineStyle = 1 Else .Offset(, -y + 1).Resize(, last_col).SpecialCells(2, 23).Interior.ColorIndex = 6 .Offset(, -y + 1).Resize(, last_col).SpecialCells(2, 23).Borders.LineStyle = 1 End If End With End Sub '=================================================== Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False On Error Resume Next Dim rg As Range Set rg = Range("a2").CurrentRegion rg.Interior.ColorIndex = 0 rg.Borders.LineStyle = 0 If Target.Count > 1 Or Target = vbNullString Then GoTo 1 Select_areas 1: Application.EnableEvents = True On Error GoTo 0 End Sub '===================================================
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.