Alaa Ammar New قام بنشر يوليو 16 مشاركة قام بنشر يوليو 16 (معدل) السلام عليكم ورحمة الله وبركاته أساتذتي الكرام جدا @محمد هشام. هل يمكن تعديل كود الترقيم اللي حضرتك تفضلت مشكورًا وأضفتهولي بحيث لا يتأثر بالفلترة، لأني حين أفلتر وأستخدم مفتاح التصفية فالناتج تظهر فيه الأرقام غير متسلسلة أنا آسف وهناك سؤال آخر إذا تكرمت أنا أنسخ رابط من الفيس او اليوتيوب في خاناتهم واكتب كلمة رابط الفيس أو رابط اليوتيوب واعملها هايبرلينك وانسخ داخلهما الرابط وبعد كدة أعيد تنسيقهم بإذالة الخط الأسبل والتكبير وتغيير اللون والحجم فهل هناك كود يسمح لي عند مجرد لصق الرابط بتاع اليوتيوب مثلا في الخلية يتحول لكلمة "رابط اليويتيوب" ويدخل فيها هذا الرابط وتحتفظ بنفس التنسيق اللي انا عامله؟ ونفس الامر مع عامود خانة الفيس وجزاك الله الخير الكثير 14-7-2024.xlsm تم تعديل يوليو 16 بواسطه Alaa Ammar New رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يوليو 16 أفضل إجابة مشاركة قام بنشر يوليو 16 بالنسبة للتسلسل يمكنك استخدام الصيغة التالية مع سحبها للاسفل بعد حدف كود ترقيم الصفوف من حدث ورقة 1 =IF(C9>0,SUBTOTAL(3,$C$9:C9),"") اما بخصوص تنسيق اعمدة الروابط اظن انه من الافضل ربط الكود مع زر يمكنك استخدامه مثلا بعد الانتهاء من نسخ جميع الروابط على العمودين جرب هدا Function tmp(Cnt As String) As Boolean Dim Request As Object Dim rc As Variant On Error GoTo EndNow Set Request = CreateObject("WinHttp.WinHttpRequest.5.1") With Request .Open "GET", Cnt, False .Send rc = .StatusText End With Set Request = Nothing If rc = "OK" Then tmp = True Exit Function EndNow: End Function Sub add_Hyperlinks() Application.ScreenUpdating = False Set WS = Sheets("Sheet1") Dim c As Excel.Range, Cnt As String, r As Excel.Range Dim a As Range, b As Range, Rng As Range lr = WS.Columns("i:j").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set a = WS.Range("i9:i" & lr): Set b = WS.Range("j9:j" & lr): Set Rng = Union(a, b) For Each c In a If c > "" Then c.Select Debug.Print c.Value Cnt = Trim(CStr(c.Text)) If Left(Cnt, 4) <> "http" Then Cnt = "http://" & Cnt If tmp(Cnt) Then WS.Hyperlinks.Add Anchor:=c, Address:=Cnt, TextToDisplay:="رابط اليوتيوب" End If Next c For Each r In b If r > "" Then r.Select Debug.Print r.Value Cnt = Trim(CStr(r.Text)) If Left(Cnt, 4) <> "http" Then Cnt = "http://" & Cnt If tmp(Cnt) Then WS.Hyperlinks.Add Anchor:=r, Address:=Cnt, TextToDisplay:="رابط الفيسبوك" End If Next r With Rng .Font.Color = RGB(0, 0, 255) .Font.Underline = xlUnderlineStyleNone .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 16 End With Application.ScreenUpdating = True End Sub 14-7-2024 V2.xlsm 3 رابط هذا التعليق شارك More sharing options...
Alaa Ammar New قام بنشر يوليو 17 الكاتب مشاركة قام بنشر يوليو 17 الشكر الجزيل لك أستاذي القدير المحترم مهما فعلت لن أوفيك حقك في الشكر جزاك الله خير الجزاء وحفظك وأسرتك من كل سوء رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان