Thêm 1 dạng PicForm (1 người xem)

anhtuan1066 · 1/9/07

Tôi thấy lúc trước trên diển đàn có tác giả làm PicForm dựa vào Comment... Và đây lại là dạng khác của PicForm, mời các bạn tham khảo
ANH TUẤN

ndu96081631 · 1/10/13

Ngoai Thanh đã viết:
Họ gọi người thuê thôi ! và đặc biệt là họ thấy thế là bình thường . chẳng khác gì tài liệu tiếng nước ngoài: thuê dịch, thế là xong . Không làm được thì thuê ! thật là đơn giản . Do thày làm với người nước ngoài nhiều nên thấy "chướng" chứ nhiều người cả đời không quan hệ với đối tác là người nước ngoài, trừ khi dùng tiền "chùa" đi du lịch thì đã có phiên dịch thì họ lo gì . OK mà thày . Cái đáng sợ là họ thấy đó là điều tất nhiên !

Tính mình rất hiếu kỳ. Mỗi khi gặp 1 vấn đề hơi "lạ lạ" là phải nhất định tìm hiểu tận gốc mới thôi
Trường hợp của bạn mình suy nghĩ mãi cũng không thấy có vấn đề gì. Ngoại trừ dòng lệnh LockAspectRatio = msoFalse không dùng được trên Excel 2003 thì các code còn lại là hoàn toàn tương thích
Tuy nhiên, để chắc ăn thì phải test trực tiếp... Cũng đã cố tìm máy nào đó có Office 2003 mà đành.. bó bột thôi
Ẹc... Ẹc... Tóm lại là: thua
(Để vài bữa hỏi thử xem ai có bộ Potable Office có hổ trợ VBA sẽ tính tiếp)

Ngoai Thanh · 1/10/13

ndu96081631 đã viết:
Tính mình rất hiếu kỳ. Mỗi khi gặp 1 vấn đề hơi "lạ lạ" là phải nhất định tìm hiểu tận gốc mới thôi
Trường hợp của bạn mình suy nghĩ mãi cũng không thấy có vấn đề gì. Ngoại trừ dòng lệnh LockAspectRatio = msoFalse không dùng được trên Excel 2003 thì các code còn lại là hoàn toàn tương thích
Tuy nhiên, để chắc ăn thì phải test trực tiếp... Cũng đã cố tìm máy nào đó có Office 2003 mà đành.. bó bột thôi
Ẹc... Ẹc... Tóm lại là: thua
(Để vài bữa hỏi thử xem ai có bộ Potable Office có hổ trợ VBA sẽ tính tiếp)

Vâng , cám ơn thày ! Nhà em cũng vậy, cái gì bây giờ chưa làm được thì sau này có điều kiện lại làm . Có việc mấy năm sau tự nhiên sực nhớ đến, khi làm được rồi , lắm lúc ngồi cười một mình . Thực ra cái này Thày Nghĩa tìm ra cái lỗi cơ bản rồi , chắc chạy trên Excel 2003 nên nó hơi chậm, Có khi nhà em tả có thể thày cũng biết nó lỗi cái gì : Tức là có lúc nếu nó xóa được ảnh khi ta kích vào sau khi phóng to, thi nó chạy tiếp bình thường . Còn không nó phóng to liên tiếp các ảnh khác khi ta kích vào và không thu nhỏ được nữa . Bây giờ sử lý được cái đó thì toàn bộ list và tên của ảnh nó không xuất hiện tại cột B nữa . Thực ra nhà em cũng muốn học các thày sử lý xem nó bị lỗi gì ? Ít ra ta cũng biết không phải lúc nào khi sử dụng Excel 2010 để ghi thành đuôi xls nó cũng chạy bình thường . Nếu lúc nào thày tìm ra lỗi,thày nhớ giúp nhà em với ! Hiện tại nhà em cứ làm trên Excel 2010 đã , khi có ai kêu nhà em tính sau . Xin cám ơn về sự uyên bác, xin cám ơn về sự tận tụy, xin cám ơn về sự nhiệt tình của thày .

siwtom · 1/10/13

Ngoai Thanh đã viết:
Vâng , cám ơn thày ! Nhà em cũng vậy, cái gì bây giờ chưa làm được thì sau này có điều kiện lại làm . Có việc mấy năm sau tự nhiên sực nhớ đến, khi làm được rồi , lắm lúc ngồi cười một mình . Thực ra cái này Thày Nghĩa tìm ra cái lỗi cơ bản rồi , chắc chạy trên Excel 2003 nên nó hơi chậm, Có khi nhà em tả có thể thày cũng biết nó lỗi cái gì : Tức là có lúc nếu nó xóa được ảnh khi ta kích vào sau khi phóng to, thi nó chạy tiếp bình thường . Còn không nó phóng to liên tiếp các ảnh khác khi ta kích vào và không thu nhỏ được nữa . Bây giờ sử lý được cái đó thì toàn bộ list và tên của ảnh nó không xuất hiện tại cột B nữa . Thực ra nhà em cũng muốn học các thày sử lý xem nó bị lỗi gì ? Ít ra ta cũng biết không phải lúc nào khi sử dụng Excel 2010 để ghi thành đuôi xls nó cũng chạy bình thường . Nếu lúc nào thày tìm ra lỗi,thày nhớ giúp nhà em với ! Hiện tại nhà em cứ làm trên Excel 2010 đã , khi có ai kêu nhà em tính sau . Xin cám ơn về sự uyên bác, xin cám ơn về sự tận tụy, xin cám ơn về sự nhiệt tình của thày .

Chen ngang tí.

Trước hết góp ý về code trong bài #35 và #43

Mã:

        InsertPic PicPath, Target, "ShpResize"    <-- ([B][COLOR=#ff0000]A[/COLOR][/B])
        Set Target = Range("A5").Offset(lR)
        lR = lR + 1

Code trên không chuẩn. Ta xét vd. trong Folder có 2 ảnh. Khi thực hiện (A) cho ảnh đầu tiên thì Target = Nothing. Hậu quả là mọi dòng lệnh trong InsertPic đều sai. Do ta dùng "On Error Resume Next" để che "mụn nhọt" nên không thấy sai. Nhưng kết quả là ảnh 1 không được nhập vào đâu cả. Ảnh 2 sẽ được nhập vào A5.
Tóm lại nếu trong folder có 1 ảnh thì không có ảnh nào được load. Nếu có n ảnh thì chỉ có (n - 1) ảnh được load. Để khắc phục thì đổi thành

Mã:

        Set Target = Range("A5").Offset(lR)
        lR = lR + 1
        InsertPic PicPath, Target, "ShpResize"

Theo lôgic thì click lần đầu tiên vào ảnh thì ảnh phải phóng to vì ảnh hiện thời đang nhỏ. Nhưng với code hiện thời thì phải click lần thứ 2 thì ảnh mới to. Tức với mỗi ảnh ta tốn 1 click vô ích. Để khắc phục thì đổi code trong ShpResize

Mã:

    If bMark = False Then
         .ScaleWidth 5, msoFalse, msoScaleFromMiddle
...
         .AlternativeText = "TRUE"
    Else
         .AlternativeText = ""
    End If

thành

Mã:

    [COLOR=#ff0000]If bMark Then[/COLOR]
         .ScaleWidth 5, msoFalse, msoScaleFromMiddle
...
         [COLOR=#ff0000].AlternativeText = ""[/COLOR]
    Else
      
        [COLOR=#ff0000].AlternativeText = "TRUE"[/COLOR]
    End If

---------------
Vấn đề Pictures trên 2003 thì tôi không rõ vì có 2003 đâu để mà test. Nhưng nói cho cùng thì bạn muốn làm được việc chứ đâu phải lấy vợ mà bắt buộc phải "hoặc "em này" hoặc sẽ không em nào cả"?

Tóm lại, bạn không thấy là "cô" WorkSheet.Shapes.AddPicture vừa nết na, chăm làm, duyên dáng mà lại ... ăn ít à?

ndu96081631 · 1/10/13

siwtom đã viết:
Tóm lại nếu trong folder có 1 ảnh thì không có ảnh nào được load. Nếu có n ảnh thì chỉ có (n - 1) ảnh được load. Để khắc phục thì đổi thành

Mã:

Set Target = Range("A5").Offset(lR) lR = lR + 1 InsertPic PicPath, Target, "ShpResize"

Chổ này thì đúng. Em sơ sót
Nhưng chổ này

siwtom đã viết:
Theo lôgic thì click lần đầu tiên vào ảnh thì ảnh phải phóng to vì ảnh hiện thời đang nhỏ. Nhưng với code hiện thời thì phải click lần thứ 2 thì ảnh mới to. Tức với mỗi ảnh ta tốn 1 click vô ích. Để khắc phục thì đổi code trong ShpResize

Mã:

If bMark = False Then .ScaleWidth 5, msoFalse, msoScaleFromMiddle ... .AlternativeText = "TRUE" Else .AlternativeText = "" End If

thành

Mã:

[COLOR=#ff0000]If bMark Then[/COLOR] .ScaleWidth 5, msoFalse, msoScaleFromMiddle ... [COLOR=#ff0000].AlternativeText = ""[/COLOR] Else [COLOR=#ff0000].AlternativeText = "TRUE"[/COLOR] End If

Thì em nghĩ là sai! Lúc đầu AlternativeText chưa có gì, mà bMark = (Len(.AlternativeText) > 0) nên bMark sẽ =FALSE
Vậy nên xét điều kiện khi bMark=FALSE mới phóng to ảnh là chính xác rồi còn gì
Nếu sửa như anh thì click vào chẳng có chuyện gì xãy ra cả
Toàn bộ code của em viết là thế này:

Mã:

Sub ShpResize()
  Dim pic As Picture
  Dim bMark As Boolean
  On Error Resume Next
  Set pic = Sheet1.Pictures(Application.Caller)
  With pic.ShapeRange
    [COLOR=#ff0000]bMark = (Len(.AlternativeText) > 0)[/COLOR]
    [COLOR=#ff0000]If bMark = False Then[/COLOR]
      .ScaleWidth 3, msoFalse, msoScaleFromMiddle
      .ScaleHeight 3, msoFalse, msoScaleFromMiddle
      .AlternativeText = "TRUE"
      .ZOrder msoBringToFront
    Else
      .Left = Range(.Name).Left: .Top = Range(.Name).Top
      .Width = Range(.Name).Width: .Height = Range(.Name).Height
      .AlternativeText = vbNullString
    End If
  End With
End Sub

Có khi anh đang nói đến code nào đó đã bị "độ" lại cũng không chừng

siwtom · 1/10/13

ndu96081631 đã viết:
Chổ này thì đúng. Em sơ sót
Nhưng chổ này

Thì em nghĩ là sai! Lúc đầu AlternativeText chưa có gì, mà bMark = (Len(.AlternativeText) > 0) nên bMark sẽ =FALSE
Vậy nên xét điều kiện khi bMark=FALSE mới phóng to ảnh là chính xác rồi còn gì
Nếu sửa như anh thì click vào chẳng có chuyện gì xãy ra cả
Toàn bộ code của em viết là thế này:

Mã:

Sub ShpResize() Dim pic As Picture Dim bMark As Boolean On Error Resume Next Set pic = Sheet1.Pictures(Application.Caller) With pic.ShapeRange [COLOR=#ff0000]bMark = (Len(.AlternativeText) > 0)[/COLOR] [COLOR=#ff0000]If bMark = False Then[/COLOR] .ScaleWidth 3, msoFalse, msoScaleFromMiddle .ScaleHeight 3, msoFalse, msoScaleFromMiddle .AlternativeText = "TRUE" .ZOrder msoBringToFront Else .Left = Range(.Name).Left: .Top = Range(.Name).Top .Width = Range(.Name).Width: .Height = Range(.Name).Height .AlternativeText = vbNullString End If End With End Sub

Có khi anh đang nói đến code nào đó đã bị "độ" lại cũng không chừng

Tôi viết rất rõ mà: "Trước hết góp ý về code trong bài #35 và #43"

Ở lần click đầu tiên thì .AlternativeText = "tên ảnh", tức bMark = TRUE

ndu96081631 · 1/10/13

siwtom đã viết:
Tôi viết rất rõ mà: "Trước hết góp ý về code trong bài #35 và #43"

Ở lần click đầu tiên thì .AlternativeText = "tên ảnh", tức bMark = TRUE

TÁC GIÁ CODE LÀ EM đấy anh à!
Dù là bài 35 hay 36 hay số mấy thì code đó cũng là của em
---------------

siwtom đã viết:
Ở lần click đầu tiên thì .AlternativeText = "tên ảnh", tức bMark = TRUE

Anh xem kỹ lại đi: Cả code ở bài 35 và 43 đều không có cái vụ .AlternativeText = "tên ảnh" đâu
Tất cả 2 code trong 2 bài ấy đều đặt điều kiện vầy: bMark = (Len(.AlternativeText) > 0)
Code bài 35:

Mã:

Sub ShpResize()
  Dim pic As Picture
  Dim bMark As Boolean
  Set pic = Sheet1.Pictures(Application.Caller)
  With pic.ShapeRange
    [COLOR=#ff0000]bMark = (Len(.AlternativeText) > 0)
    If bMark = False Then[/COLOR]
      .ScaleWidth 5, msoFalse, msoScaleFromMiddle
      .ScaleHeight 5, msoFalse, msoScaleFromMiddle
   [COLOR=#ff0000]   .AlternativeText = "TRUE"[/COLOR]
      .ZOrder msoBringToFront
    Else
      .Left = Range(.Name).Left: .Top = Range(.Name).Top
      .Width = Range(.Name).Width: .Height = Range(.Name).Height
      [COLOR=#ff0000].AlternativeText = vbNullString[/COLOR]
    End If
  End With
End Sub

Code bài 43:

Mã:

Sub ShpResize()
  Dim pic As Shape
  Dim bMark As Boolean
  Set pic = ActiveSheet.Shapes(Application.Caller)
  With pic
   [COLOR=#ff0000] bMark = (Len(.AlternativeText) > 0)
    If bMark = False Then[/COLOR]
      .ScaleWidth 5, msoFalse, msoScaleFromMiddle
      .ScaleHeight 5, msoFalse, msoScaleFromMiddle
      [COLOR=#ff0000].AlternativeText = "TRUE"[/COLOR]
      .ZOrder msoBringToFront
    Else
      .Left = Range(.Name).Left: .Top = Range(.Name).Top
      .Width = Range(.Name).Width: .Height = Range(.Name).Height
     [COLOR=#ff0000] .AlternativeText = ""[/COLOR]
    End If
  End With
End Sub

Còn chuyện có tên ảnh trong AlternativeText thì đó cũng là sơ suất của người ta, chẳng ảnh hưởng gì đến code cả. Dù lần đầu click có trục trặc thì những lần sau vẫn êm xuôi
Vậy nên phần code này không cần phải sửa gì cả
(File ở bài 35 bị lỗi là vì 1 chuyện hoàn toàn khác, đã xử lý xong)

siwtom · 1/10/13

Cái này ai cũng kiểm tra được mà. Nhưng thôi, tôi đành mất công vậy

Thao tác: tải về --> giải nén --> kích hoạt Player --> File --> Open --> chọn test.avi --> file --> play

http://www.mediafire.com/download/i01g03uvtivjppb/test.rar

ndu96081631 đã viết:
TÁC GIÁ CODE LÀ EM đấy anh à!
Dù là bài 35 hay 36 hay số mấy thì code đó cũng là của em
---------------

Anh xem kỹ lại đi: Cả code ở bài 35 và 43 đều không có cái vụ .AlternativeText = "tên ảnh" đâu
Tất cả 2 code trong 2 bài ấy đều đặt điều kiện vầy: bMark = (Len(.AlternativeText) > 0)
Code bài 35:

Mã:

Sub ShpResize() Dim pic As Picture Dim bMark As Boolean Set pic = Sheet1.Pictures(Application.Caller) With pic.ShapeRange [COLOR=#ff0000]bMark = (Len(.AlternativeText) > 0) If bMark = False Then[/COLOR] .ScaleWidth 5, msoFalse, msoScaleFromMiddle .ScaleHeight 5, msoFalse, msoScaleFromMiddle [COLOR=#ff0000] .AlternativeText = "TRUE"[/COLOR] .ZOrder msoBringToFront Else .Left = Range(.Name).Left: .Top = Range(.Name).Top .Width = Range(.Name).Width: .Height = Range(.Name).Height [COLOR=#ff0000].AlternativeText = vbNullString[/COLOR] End If End With End Sub

Code bài 43:

Mã:

Sub ShpResize() Dim pic As Shape Dim bMark As Boolean Set pic = ActiveSheet.Shapes(Application.Caller) With pic [COLOR=#ff0000] bMark = (Len(.AlternativeText) > 0) If bMark = False Then[/COLOR] .ScaleWidth 5, msoFalse, msoScaleFromMiddle .ScaleHeight 5, msoFalse, msoScaleFromMiddle [COLOR=#ff0000].AlternativeText = "TRUE"[/COLOR] .ZOrder msoBringToFront Else .Left = Range(.Name).Left: .Top = Range(.Name).Top .Width = Range(.Name).Width: .Height = Range(.Name).Height [COLOR=#ff0000] .AlternativeText = ""[/COLOR] End If End With End Sub

Còn chuyện có tên ảnh trong AlternativeText thì đó cũng là sơ suất của người ta, chẳng ảnh hưởng gì đến code cả. Dù lần đầu click có trục trặc thì những lần sau vẫn êm xuôi

Tôi có nói code không êm xuôi đâu. Tôi chỉ nói "phí" 1 lần click đầu tiên sau khi load ảnh.

Vậy nên phần code này không cần phải sửa gì cả
(File ở bài 35 bị lỗi là vì 1 chuyện hoàn toàn khác, đã xử lý xong)

Tôi có bàn về chuyện lỗi kia đâu???

Mà người góp ý thì cứ góp ý còn việc sửa hay không thì là chuyện của người khác. Chả ai bắt ai đâu mà
-------------
Xem video các bạn thấy tôi click lần đầu vào ảnh nhỏ thì theo lôgic sau khi click nó phải to lên do ảnh đang nhỏ. Nhưng nó không to lên

Ngoai Thanh · 1/10/13

Cám ơn thày NDU và thày Siwtom, nhà em mới được hơn 1 tuổi GPE nên chủ yếu là học và chủ yếu là hỏi chứ chưa dám trả lời và càng không dám bàn về thuật toán, về Vba . Nếu text code chạy đúng yêu cầu cẩn hỏi thì cám ơn và sử dụng, nếu chưa được thì lại vào nhờ các thày sửa giúp đến lúc đạt yêu cầu thì thôi . Lần này thằng Excel 2003 nó làm loạn lên, ngại quá . Xin cám ơn các thày .

ndu96081631 · 1/10/13

siwtom đã viết:
Tôi có bàn về chuyện lỗi kia đâu???
Mà người góp ý thì cứ góp ý còn việc sửa hay không thì là chuyện của người khác. Chả ai bắt ai đâu mà

Anh góp ý thì em và mọi người đều cảm ơn (chuyện đương nhiên)
----------------------------------------------------
Ngoài lề một chút:
Em biết là anh đã xem qua topic này vài lần, chắc cũng định bỏ đi rồi nhưng vì thấy thằng em nó sai mà không ai phát hiện nên anh ngứa tay vào đây góp vài lời (em rất cảm ơn về điều này)
Em biết là anh ngại giao tiếp với em nên đã "nói tránh" đi là góp ý cho bài này, bài nọ (không phải bài của em)...
Ẹc... Ẹc... dù là bài nào trong topic này cũng có liên quan đến em thôi
Em khộng ngại mà nói thằng rằng: thời gian gần đây em cũng ngại giao tiếp với anh, vì anh hay nỗi nóng bất thường nên sau này em chẳng khi nào góp ý bất cứ vấn đề gì có liên đến code anh viết (anh thừa hiểu lý do vì sao)
Thôi thì đã lỡ vào đây rồi, có góp ý anh cứ góp ý thẳng (không cần phải "nói tránh" đi đâu). Tính em phân biệt rõ ràng lắm, dù có ghét ai đến mấy nhưng vẫn chịu học hỏi nếu người đó có cái hay... huống chi em với anh dù có "tránh mặt" nhau cũng đâu phải thuộc dạng ghét cay ghét đăng hay thù hằn gì
Anh nghĩ em nói đúng không?
----------------------------------------------------
Ôi... mông lung quá! --=0

siwtom · 1/10/13

ndu96081631 đã viết:
Anh góp ý thì em và mọi người đều cảm ơn (chuyện đương nhiên)
----------------------------------------------------
Ngoài lề một chút:
Em biết là anh đã xem qua topic này vài lần, chắc cũng định bỏ đi rồi nhưng vì thấy thằng em nó sai mà không ai phát hiện nên anh ngứa tay vào đây góp vài lời (em rất cảm ơn về điều này)
Em biết là anh ngại giao tiếp với em nên đã "nói tránh" đi là góp ý cho bài này, bài nọ (không phải bài của em)...
Ẹc... Ẹc... dù là bài nào trong topic này cũng có liên quan đến em thôi
Em khộng ngại mà nói thằng rằng: thời gian gần đây em cũng ngại giao tiếp với anh, vì anh hay nỗi nóng bất thường nên sau này em chẳng khi nào góp ý bất cứ vấn đề gì có liên đến code anh viết (anh thừa hiểu lý do vì sao)
Thôi thì đã lỡ vào đây rồi, có góp ý anh cứ góp ý thẳng (không cần phải "nói tránh" đi đâu). Tính em phân biệt rõ ràng lắm, dù có ghét ai đến mấy nhưng vẫn chịu học hỏi nếu người đó có cái hay... huống chi em với anh dù có "tránh mặt" nhau cũng đâu phải thuộc dạng ghét cay ghét đăng hay thù hằn gì
Anh nghĩ em nói đúng không?
----------------------------------------------------
Ôi... mông lung quá!

Không hiểu Tuấn định gây sự gì nhỉ? Cứ nói hết đi.

Hãy để ý là không chỗ nào tôi nói: bài của Nghĩa, bài của Thanh. Vì tôi thừa biết là không phải. Tôi nói bài #35 và #43 chỉ là để chỉ cho mọi người biết tôi định nói tới bài nào. Vì rất có thể ai đó muốn tải file về để kiểm chứng. Nếu tôi không nói rõ bài nào thì "họ" bằng cách nào biết? Có chỗ nào tôi nói là bài của Nghĩa, của Thanh không? Hay bắt bẻ tôi chỉ vì chuyện tủn mủn? Tôi phải viết thế nào? Là phải viết: "Trước hết góp ý về code trong bài #35 và #43 - tác giả là ndu"??? Không có thêm đoạn "tác giả là ndu" thì là "nói tránh"? Khó hiểu quá.

Còn chuyện mà bạn nói là "anh thừa hiểu lý do vì sao" thì tôi không muốn gợi lại làm gì. Vì cho dù thế nào thì tôi cũng bị gán cái mác "nóng tính", "không biết tiếp thu" ... Nhưng tôi rất biết phải trái. Nhiều người nói tôi sai chỗ này, code chỗ nọ bị lỗi. Tôi đã từng xin lỗi và cám ơn nhiều người góp ý. Không có bài nào chỉ ra những sơ xuất trong code mà tôi lờ đi, giả vờ không biết. Mà nhiều người đã và đang giả vờ như thế đấy.

Tôi biết tiếp thu, tôi biết nói lời cám ơn và cả xin lỗi. Không có gì phải hổ thẹn khi nói lời xin lỗi. Nhưng tôi chỉ sẵn sàng tiếp thu, lắng nghe ý kiến khi mà đó là lời góp ý thẳng thắn. Đừng có kiểu muốn góp ý nhưng lại bịa ra chuyện: "nghe nhiều người nói là ...". Người ta quan tâm tới code của tôi và rất muốn dùng nhưng có chỗ chưa hiểu? Nếu không quan tâm thì chả ai rỗi hơi đi phàn nàn với người khác. Còn nếu quan tâm, muốn dùng, muốn hỏi thì có lẽ người ta sẽ hỏi trực tiếp tác giả chứ nhỉ? Hay muốn dùng muốn hỏi nhưng tiếc lời, đành tốn chút xèng gọi điện cho người khác để phàn nàn? Tôi không tin có chuyện như thế.

Góp ý? Sẵn sàng, nhưng cứ nói thẳng. Đừng quanh co, bịa tình huống.

Tôi đã quá chán những xung đột không nên có nên cố tình giảm cơ hội đụng độ với mọi người thôi. Nhưng bạn có thể tự bịa ra những lý do mà bạn cho là đúng. Nào là "để bụng", "ghét", "thù". Xin cứ tự nhiên.

Tôi góp ý có cái gì sai không? Nếu sai thì nói ra để tôi rút kinh nghiệm. Còn nếu đúng thì tại sao lại có chuyện "kể" ra những chuyện như trên? Hay là vì: "Anh góp ý đúng rồi nhưng tôi biết tỏng là anh chụp cơ hội để tấn công tôi"? Bởi nếu không thì tại sao lại có những đoạn như trên? Nếu góp ý mà rồi bị chụp mũ như thế thì tôi sẽ không muốn góp ý nữa. Chỉ cần một lời: Tôi không muốn anh góp ý cho những bài của tôi. Chỉ một lời thôi thì có thể yên tâm là tôi sẽ không bao giờ góp ý nữa.

Tôi sẽ không viết thêm gì nữa.
-----------------
Tôi đã nói là không viết thêm nữa tức sẽ không có chuyện tranh luận gì ở đây. Vậy đề nghị BQT để nguyên bài này của tôi. Một ý kiến, vài lời giải thích nhưng của người có văn hóa mà. Chuyện nói thẳng vì là toàn là đàn ông mà lại đàn ông có tuổi mà.

ndu96081631 · 2/10/13

siwtom đã viết:
K
Góp ý? Sẵn sàng, nhưng cứ nói thẳng. Đừng quanh co, bịa tình huống.
Tôi góp ý có cái gì sai không? Nếu sai thì nói ra để tôi rút kinh nghiệm. Còn nếu đúng thì tại sao lại có chuyện "kể" ra những chuyện như trên?

Vâng! Có sai chứ anh! Đó là trường hợp anh nói về AlternativeText
Anh cho rằng nên đổi If bMark Then (thay vì If bMark = FALSE Then)
Đó là vì anh cho rằng chuổi trong AlternativeText luôn tồn tại, khi ấy bMark đã = TRUE trước nên phải click lần thứ 2 hình mới được phóng to. Trường hợp này ĐÚNG
Nhưng sao anh chắc rằng chuổi trong AlternativeText luôn tồn tại? Đặt trường hợp mới chèn hình vào, nó rổng thật sự thì nếu sửa code lại như anh góp ý hóa ra cũng lại phải click đến lần thứ 2 ảnh mới được phóng to. Trường hợp này lại SAI
Anh cứ xem video clip sẽ biết: http://www.mediafire.com/download/bibtipaehi6j7ol/test_2.avi
Ở đây, nếu hoàn hảo thì lý ra khi chèn hình ta xử lý xóa chuổi trong AlternativeText luôn mới đúng
(nhưng dù sao chuyện này cũng không quan trọng nên em không nhắc)

siwtom đã viết:
Tôi sẽ không viết thêm gì nữa.
-----------------
Tôi đã nói là không viết thêm nữa tức sẽ không có chuyện tranh luận gì ở đây. Vậy đề nghị BQT để nguyên bài này của tôi. Một ý kiến, vài lời giải thích nhưng của người có văn hóa mà. Chuyện nói thẳng vì là toàn là đàn ông mà lại đàn ông có tuổi mà.

Hình như anh chưa hiểu ý em thì phải (cũng như bao lần trước)
Em không giỏi ăn nói nhưng được cái là nghĩ sao nói vậy, lý ra anh phải không nên giận thằng em này mới đúng (nó thật lòng)
Dù sao, nếu vì những lời nói của em mà anh phiền lòng thì em thành thật xin lỗi vậy

Ngoai Thanh · 2/10/13

Các thày cũng cho nhà em nói thẳng là "một nửa" của ta đáng yêu, đáng quý biết bao nhiêu mà nhiều khi vẫn phải "Quay mặt làm ngơ" mà . Với hai thày vừa là "cao thủ" của GPE cả về kiến thức, cả về tuổi đời và cả về đối nhân sử thế ; Máy móc là "kẻ" vô tri mà còn xung đột mà . Theo nhà em thì " Không có giải nhất" là phương án tối ưu , Mong các thày đừng cho rằng nhà em " nói leo " .

ndu96081631 · 2/10/13

Ngoai Thanh đã viết:
Các thày cũng cho nhà em nói thẳng là "một nửa" của ta đáng yêu, đáng quý biết bao nhiêu mà nhiều khi vẫn phải "Quay mặt làm ngơ" mà . Với hai thày vừa là "cao thủ" của GPE cả về kiến thức, cả về tuổi đời và cả về đối nhân sử thế ; Máy móc là "kẻ" vô tri mà còn xung đột mà . Theo nhà em thì " Không có giải nhất" là phương án tối ưu , Mong các thày đừng cho rằng nhà em " nói leo " .

Tại anh trai tôi hay nhạy cảm thôi mà. Không có gì đâu!
------------------------------------
Ở trên anh siwtom có 1 gợi ý rất hay về Shapes.AddPicture (cái này quả thật là bây giờ tôi mới biết)
Tôi sẽ cố gắng sưa code theo hướng đi này. Hy vọng có thể giải quyết khó khăn cho bạn
Chờ chút nha...

ndu96081631 · 2/10/13

Đã xong! Code sửa lại khá nhiều

Mã:

Public aFiles, sFolder As String
Sub ShpResize()
  Dim shp As Shape, rngPos As Range
  Dim bMark As Boolean
  On Error Resume Next
  Set shp = ActiveSheet.Shapes(Application.Caller)
  With shp
    Set rngPos = Range(.Name)
    bMark = (Len(.AlternativeText) > 0)
    If bMark = False Then
      .ScaleWidth 3, msoFalse, msoScaleFromMiddle
      .ScaleHeight 3, msoFalse, msoScaleFromMiddle
      .AlternativeText = "TRUE"
      .ZOrder msoBringToFront
    Else
      .Left = rngPos.Left: .Top = rngPos.Top
      .Width = rngPos.Width: .Height = rngPos.Height
      .AlternativeText = ""
    End If
  End With
End Sub

Mã:

Sub ShpReset()
  Dim shp As Shape, bMark As Boolean, rngPos As Range
  On Error Resume Next
  For Each shp In ActiveSheet.Shapes
    With shp
      If .Name Like "$*$*" Then
        bMark = (Len(.AlternativeText) > 0)
        Set rngPos = Range(.Name)
        .Left = rngPos.Left: .Top = rngPos.Top
        .Width = rngPos.Width: .Height = rngPos.Height
        If bMark Then .AlternativeText = vbNullString
      End If
    End With
  Next
End Sub

Mã:

Sub SelectFolder()
  Dim arr, vFolder, pic
  Dim Target As Range, shp As Shape
  Dim lR As Long
  Dim PicPath As String
  On Error Resume Next
  vFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
  If TypeName(vFolder) = "String" Then
    If Right(vFolder, 1) <> "\" Then vFolder = vFolder & "\"
    arr = FilesFoldersList(vFolder, True, "*.jpg", False)
    If IsArray(arr) Then
      aFiles = arr
      sFolder = CStr(vFolder)
      Range("F1") = sFolder
      For Each pic In arr
        PicPath = sFolder & CStr(pic)
        Set Target = Range("A5").Offset(lR)
        lR = lR + 1
        Set shp = InsertPic(PicPath, Target, "ShpResize")
      Next
      Range("F1").Select
    End If
  End If
End Sub

Mã:

Function InsertPic(ByVal PicPath As String, ByVal Target As Range, Optional ByVal Action As String = "") As Shape
  Dim shp As Shape
  On Error Resume Next
  With Target
    .Parent.Shapes(Target.Address).Delete
    Set shp = .Parent.Shapes.AddPicture(PicPath, True, True, .Left, .Top, .Width, .Height)
  End With
  If Not shp Is Nothing Then
    shp.Name = Target.Address
    shp.AlternativeText = ""
    If Val(Application.Version) > 11 Then shp.LockAspectRatio = msoFalse
    shp.OnAction = Action
    Set InsertPic = shp
  End If
End Function

---------------
Riêng có đoạn bạn Ngoai Thanh hỏi rằng:

Ngoai Thanh đã viết:
Bây giờ sử lý được cái đó thì toàn bộ list và tên của ảnh nó không xuất hiện tại cột B nữa

Đó là vì ngoài code trong Module còn có code sự kiện Change, SelectionChange (nằm trong Sheet). Bạn copy ra file khác nhưng quên không mang theo mấy code này nên phần Validation list không hoạt động. Chú ý nha!
Phần sự kiện Change trong file mới tôi cũng cải tiến thêm 1 chút: Cho phép copy hoặc xóa cùng lúc nhiều cell (lúc trước chỉ hoạt động có 1 cell)
Vậy nên, giờ đây nếu:
- Bạn xóa 5 cell ở cột B cùng lúc thì 5 cell tương ứng bên cột A sẽ lập tức bị xóa hình
- Bạn copy đâu đó 5 cell rồi paste vào cột B thì lập tức 5 cell bên cột B được chèn hình (nếu tên hình tồn tại)
Kiểm tra lại giúp tôi xem còn chổ nào trục trặc nữa không?

Ngoai Thanh · 2/10/13

Riêng có đoạn bạn Ngoai Thanh hỏi rằng:

Đó là vì ngoài code trong Module còn có code sự kiện Change, SelectionChange (nằm trong Sheet). Bạn copy ra file khác nhưng quên không mang theo mấy code này nên phần Validation list không hoạt động. Chú ý nha!
Phần sự kiện Change trong file mới tôi cũng cải tiến thêm 1 chút: Cho phép copy hoặc xóa cùng lúc nhiều cell (lúc trước chỉ hoạt động có 1 cell)
Vậy nên, giờ đây nếu:
- Bạn xóa 5 cell ở cột B cùng lúc thì 5 cell tương ứng bên cột A sẽ lập tức bị xóa hình
- Bạn copy đâu đó 5 cell rồi paste vào cột B thì lập tức 5 cell bên cột B được chèn hình (nếu tên hình tồn tại)
Kiểm tra lại giúp tôi xem còn chổ nào trục trặc nữa không?[/QUOTE]
-----
Cám ơn thày ! Code chạy tốt trên Excel 2003 rồi ạ . Song có điều thày giúp nhà em thêm chút nữa là : Tất cả tính năng như File cũ ( Khi điều chỉnh cell ảnh tự động điều chỉnh theo - điều này để điều chỉnh sự cân đối của ảnh )
Dù phóng to theo tỷ lệ nào thì khi thu nhỏ ảnh cũng về kích thước ban đầu ( Hiện tại ảnh được thu về theo tỷ lệ , nên có lúc nó thu về kích thước nhỏ hơn cell hiện tại, vả lại kích thước ảnh không phải lúc nào cũng giống nhau nên nhà em phải điều chỉnh chiều rộng và chiều dài khác nhau để cân đối ảnh nên khi thu nhỏ rất cần nó trở lại kích thước ban đầu .
kể cả hiện tên của ảnh tại cột B ngay từ đầu, chỉ khi nào cần đổi ảnh thì mới dùng list để đổi . Nói thế này cho dễ hiểu thày ạ : Các yêu cầu như file cũ chạy trên Excel 2010 là chuẩn rồi , Bây giờ sử lý file này chạy trên Excel 2003 cũng như vậy để cho nó đồng bộ thày ạ ? Xin cám ơn và chào thày !

ndu96081631 · 2/10/13

Ngoai Thanh đã viết:
Cám ơn thày ! Code chạy tốt trên Excel 2003 rồi ạ . Song có điều thày giúp nhà em thêm chút nữa là : Tất cả tính năng như File cũ ( Khi điều chỉnh cell ảnh tự động điều chỉnh theo - điều này để điều chỉnh sự cân đối của ảnh )

Khi bạn điều chỉnh kích thước cell xong, chỉ cần click chuột vào 1 cell nào đó là ảnh tự cân chỉnh thôi mà. Tính năng này được thực hiện từ sự kiện SelectionChange:

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error Resume Next
  [B][COLOR=#ff0000]ShpReset[/COLOR][/B]
  If Not Intersect(Range("B5:B30"), Target) Is Nothing Then
    If Target.Count = 1 Then
      If IsArray(aFiles) Then
        With Target.Validation
          .Delete
          .Add 3, , , Join(aFiles, ",")
        End With
      End If
    End If
  End If
End Sub

Có khi nào bạn đã bỏ quên code này không?

Ngoai Thanh đã viết:
Dù phóng to theo tỷ lệ nào thì khi thu nhỏ ảnh cũng về kích thước ban đầu ( Hiện tại ảnh được thu về theo tỷ lệ , nên có lúc nó thu về kích thước nhỏ hơn cell hiện tại, vả lại kích thước ảnh không phải lúc nào cũng giống nhau nên nhà em phải điều chỉnh chiều rộng và chiều dài khác nhau để cân đối ảnh nên khi thu nhỏ rất cần nó trở lại kích thước ban đầu .
!

Phóng to thì theo tỷ lệ nhưng khi thu nhỏ tôi đâu có viết code để thu nhỏ ngược lại đâu!
Khi thu nhỏ, code chỉnh kích thước hình theo cell mà bạn:

Mã:

Sub ShpResize()
  Dim shp As Shape, rngPos As Range
  Dim bMark As Boolean
  On Error Resume Next
  Set shp = ActiveSheet.Shapes(Application.Caller)
  With shp
    Set rngPos = Range(.Name)
    bMark = (Len(.AlternativeText) > 0)
    If bMark = False Then
      .ScaleWidth 3, msoFalse, msoScaleFromMiddle
      .ScaleHeight 3, msoFalse, msoScaleFromMiddle
      .AlternativeText = "TRUE"
      .ZOrder msoBringToFront
    Else
      [COLOR=#ff0000].Left = rngPos.Left: .Top = rngPos.Top
      .Width = rngPos.Width: .Height = rngPos.Height[/COLOR]
      .AlternativeText = ""
    End If
  End With
End Sub

Chổ màu đỏ ấy

Ngoai Thanh · 2/10/13

Thưa thày, khi đã load ảnh điều chỉnh cell ảnh không điều chỉnh theo đâu ạ . chỉ khi đổi ảnh nó mới điều chỉnh theo kích thước mới thày ạ . Và khi load ảnh thì load cả tên bên cột B ạ .

ndu96081631 · 2/10/13

Ngoai Thanh đã viết:
Thưa thày, khi đã load ảnh điều chỉnh cell ảnh không điều chỉnh theo đâu ạ . chỉ khi đổi ảnh nó mới điều chỉnh theo kích thước mới thày ạ .

Bạn đưa file của bạn lên đây xem thử! Tôi test không phát hiện có gì bất thường cả (kích thước ảnh được điều chỉnh ngon lành cho cả 2 trường hợp load ảnh mới và thay đổi ảnh theo validation)

Ngoai Thanh · 2/10/13

ndu96081631 đã viết:
Bạn đưa file của bạn lên đây xem thử! Tôi test không phát hiện có gì bất thường cả (kích thước ảnh được điều chỉnh ngon lành cho cả 2 trường hợp load ảnh mới và thay đổi ảnh theo validation)

Cám ơn thày Nhà em gưi file để thày kiểm tra giúp ạ .

ndu96081631 · 2/10/13

Ngoai Thanh đã viết:
Cám ơn thày Nhà em gưi file để thày kiểm tra giúp ạ .

Trong code này:

Mã:

Function InsertPic(ByVal PicPath As String, ByVal Target As Range, Optional ByVal Action As String = "") As Shape
  Dim shp As Shape
  On Error Resume Next
  With Target
    .Parent.Shapes(Target.Address).Delete
    Set shp = .Parent.Shapes.AddPicture(PicPath, True, True, .Left, .Top, .Width, .Height)
  End With
  If Not shp Is Nothing Then
    shp.Name = Target.Address
    shp.AlternativeText = ""
   [COLOR=#ff0000] If Val(Application.Version) > 11 Then shp.LockAspectRatio = msoFalse[/COLOR]
    shp.OnAction = Action
  End If
End Function

Chổ màu đỏ bạn sửa thành

Mã:

[COLOR=#ff0000] shp.LockAspectRatio = msoFalse[/COLOR]

Tức bỏ IF ở đàng trước
Do không có Excel 2003 để test và tôi đoán rằng LockAspectRatio chỉ hoạt động từ Excel 2007 trở lên nên đã IF như vậy
Cứ thử bỏ rồi test lại xem sao nhé

Thêm 1 dạng PicForm (1 người xem)

Người dùng đang xem chủ đề này

Thành viên gạo cội

File đính kèm

Huyền thoại GPE

Cánh Diều xanh

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Cánh Diều xanh

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Cánh Diều xanh

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Cánh Diều xanh

Huyền thoại GPE

Cánh Diều xanh

Huyền thoại GPE

Cánh Diều xanh

File đính kèm

Huyền thoại GPE

Đếm ngược thời gian