anhtuan1066
Thành viên gạo cội
- Tham gia
- 10/3/07
- Bài viết
- 5,802
- Được thích
- 6,912
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
ANH TUẤN
Thêm 1 dạng PicForm (2 người xem)
- Thread starter anhtuan1066
- Ngày gửi
Người dùng đang xem chủ đề này
Thành viên gạo cội
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
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é[/QUOTE]
Đúng rồi thày ạ, còn cho hiện tên cùng với ảnh tại list khi load ảnh ngay lần đầu thì sửa code thế nào ạ ?
Cứ thử bỏ rồi test lại xem sao nhé[/QUOTE]
Đúng rồi thày ạ, còn cho hiện tên cùng với ảnh tại list khi load ảnh ngay lần đầu thì sửa code thế nào ạ ?
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Quá dễ:
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")
[COLOR=#ff0000]Target.Offset(, 1) = CStr(pic)[/COLOR]
Next
Range("F1").Select
End If
End If
End Sub
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Cám ơn thày ! hoàn chỉnh rồi thày ạ . Nhưng Danh hiệu ăn GPe, ở GPe của thày đúng cả nghĩa bóng và nghĩa đen . Vì diễn đàn lúc nào cũng thấy thầy có mặt . Vậy thầy bật mí cho bọn em biết buổi trưa thày vẫn ngồi trên máy thì "cô giáo " cho ăn gì ạ ?
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Có lẽ nhà em phiền nhiều quá, Nhà em đã viết thêm dòng lệnh xóa cả cột B, rồi chèn lại . Kể không pro lắm nhưng nó chạy tàm tạm rồi ạ. Xin cám ơn thày !
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Cái đó tôi có thấy nhưng chưa tiến hành là vì liên quan đến cái vụ 2003 của bạn đấy!
Bây giờ bạn vui lòng thí nghiệm giùm tôi thế này nhé:
- Mở 1 file Excel trắng
- Chèn 1 vài hình (chèn bằng tay)
- Xong bạn chạy code này thử:
Mã:
Sub Test()
ActiveSheet.Pictures.Delete
End SubLưu ý: thí nghiệm trên phải được thực hiện trên Excel 2003 nhé
Lần chỉnh sửa cuối:
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Cám ơn thày, nhà em sợ thày bận nên mày mò . Vâng nhà em sẽ thử và thông báo ạ !
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Sub chạy tốt thày ạ ! Nhà em hiểu ý thày rồi : cho dòng lệnh trên vào sub SelectFolder Ngay dưới dòng lệnh On Error Resume Next và chạy tốt rồi thày ạ, tức là trước khi lấy ảnh mới thì xóa toàn bộ ảnh cũ . Thấy thày chạy giúp mọi người khắp diễn đàn nhà em thấy ngại thật sự ! Xin Cám ơn thày, người thày tận tụy !
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Ai bảo bạn làm thế nhỉ? Không bao giờ Thầy NDU "trảm" Object mà không có tên tuổi! Bạn mà dùng câu lệnh đó thì vô hình chung nó xóa tất cả các hình trên sheet thì khổ đấy! Trừ khi bạn muốn là thế!
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Đúng rồi đó thầy ! Vì sau đó ta nạp ảnh mới toàn bộ mà , còn nếu muồn thay một vài ảnh thì thay bằng list chứ không chạy sub nữa . Kể thày nhắc cũng nguy hiểm , nhỡ ai đó "bấm chơi" một cài thì tèo ( nếu vậy thì bỏ nút bấm và chạy bằng lệnh tắt, nếu ai không biết lệnh thì không chạy được ) , Nghe có vẻ không ổn lắm . Nhưng thực nhà em thấy phiền các thày nhiều nên cố tự lực chút ! cám ơn thày chỉ dẫn .
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Nếu bạn muốn xóa tất cả thì tôi cũng có một cái thủ tục cho bạn, nó xóa tất Picture, kể cả những Shape!
ActiveSheet.DrawingObjects.Delete
Tuy nhiên, tôi không khuyến khích bạn dùng thủ tục này, bởi một lúc nào đó ta giữ vài hình ảnh lại, LOGO cty chẳng hạn, đã là một chương trình gì đó, bạn không muốn để một vài hình ảnh về bạn sao nhỉ?
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Thực ra Thày nhắc mới nhớ, nói chung có vẻ không an toàn . Yêu cầu là xóa toàn bộ ảnh đã nạp vào cột B thày ạ , vậy dòng lệnh viết thế nào ạ ?
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Chỉ có thể là dùng vòng lặp thôi! Đặt tên hình cũng rất quan trọng, nếu đặt tên theo địa chỉ ô như Thầy NDU làm thì rất dễ quản lý, muốn xóa cũng rất thuận tiện!
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Không biết trên Excel 2003 bạn có thể xóa hình bằng cách này không nhỉ:
Bạn thử insert các picture và đặt tên lần lượt như các tên có màu xanh rồi cho chạy thủ tục đó xem nó có dùng được không, hiện tại tôi đang dùng Excel 2010 nên không test được!
Mã:
Sub XoaHinh()
ActiveSheet.Shapes.Range(Array([COLOR=#0000ff]"Picture 1", "Picture 2", "Picture 3"[/COLOR])).Delete
End SubBạn thử insert các picture và đặt tên lần lượt như các tên có màu xanh rồi cho chạy thủ tục đó xem nó có dùng được không, hiện tại tôi đang dùng Excel 2010 nên không test được!
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Bây giờ nhà em chỉ cần xóa hết ảnh từ B5 trở đi để nạp ảnh mới . Vì dòng lệnh trên xóa hết ảnh trên sheet nên không an toàn . Hay nhất là sửa được câu lệnh xóa ảnh cũ nạp ảnh mới Thành xóa toàn bộ ảnh cũ trước khi nạp ảnh mới thày ạ, nhưng nhà em không biết sửa thế nào vì code liên quan đến tất cả các sub nên nhà em không dám mạo hỉểm .
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Chắc chắn là được, thày ạ . Nhưng tên ảnh không đổi được, từ hôm qua đến giờ thày NDU đã giúp và sử dụng tốt rồi ạ ( tức là nạp ảnh và cà tên theo thư mục ảnh ). Giờ chỉ cần xóa ảnh cũ vì nếu lần nạp sau ít ảnh hơn lần trước đó thì còn một số ảnh trước đó vẫn tồn tại ngoài yêu cầu mà thày . cần xóa số ảnh thừa này ạ.
Upvote
0
- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Haha, bạn có biết khi tôi vọc code, tôi đã lưu lại nhiều file không? Hoặc giả tôi vọc tùm lum nhưng khi thoát tôi không lưu lại hoặc save as thành file mới không? Bạn cứ vọc thoải mái sợ quái gì code chứ!
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
"Vọc" code thì nhà em "vọc" nhiều rồi, nhưng với code down trên diễn đàn về vì thấy hay hoặc gần đúng với yêu cầu của mình thì sửa theo ý mình, nếu không được thì bỏ . Nhưng đây là công sức của các thày bỏ ra để giúp cụ thể theo yêu cầu file của mình vả lại trình độ các thày cao hơn nhà em rất nhiều nên sửa kiểu gì cũng "lợn lành thành lợn què thôi ", bởi xem code phần lớn còn chưa hiểu , sao dám sửa ạ ! Nhưng thày khuyến khích " Sợ quái gì nó " nên nhà em coppy sang một tập rồi "Vọc đại đi ", cuối cùng thì có vẻ nó "nể" mình nên chạy . Lúc đầu do cứ tìm cách chọn ảnh để xóa nên thất bại (nó yêu cầu phải chọn từng ảnh theo từng cell theo địa chỉ tuyệt đối hoặc đích danh tên ảnh , nó mới xóa ). Cuối cùng nhà em thêm 2 câu lệnh sau vào ngay đầu code để nó xóa ảnh cũ trước khi load ảnh mới :
Range([A5], [B5].End(xlDown).Resize(, 1)).Select
Selection.ClearContents
Té ra không phải ảnh load vào comment mà là trên cell và do tên tại cột B sinh ra , (cột A chỉ là cái khung chứa ảnh) nên nó nghe, trước đó cứ chọn cột A để xóa nên không đựợc . Cám ơn các thày đã giúp đỡ và chỉ dẫn .
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Chẳng sao cả!
Nếu bạn chắc rằng trên bảng tính không có bất cứ HÌNH nào "ngoài luồng" thì chơi được. Ở đây tôi nhắc đến từ HÌNH có nghĩa là Picture, các object khác (như hình vẽ, button...) không được tính
Vậy code thế này:
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
[COLOR=#ff0000]ActiveSheet.Pictures.Delete[/COLOR]
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")
Target.Offset(, 1).Value = CStr(pic)
Next
Range("F1").Select
End If
End If
End Sub--------------
Trường hợp khác: trên sheet, ngoài hình chèn bằng code còn có những hình khác được chèn bằng tay. Để xóa những hình trước đó đã nạp (tại cột A) thì thay đoạn màu đỏ ở trên bằng code:
Mã:
Range("B5:B1000").ClearContents
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,958
Thay vì Select, rồi lại Selection.ClearContents. Bạn có thể gộp lại thành:
Range([B5], [B5].End(xlDown).Resize(, 1)).ClearContents
Tuy nhiên, dùng End(xlDown) có khi bị "sa bẫy" trong trường hợp cột B có cell rổng ở giữa nha
Upvote
0
Ngoai Thanh
Cánh Diều xanh
- Tham gia
- 14/6/12
- Bài viết
- 823
- Được thích
- 906
Úi dà ! Nhà em vừa gửi bài xong quay lại thấy bài của thày. May quá, đúng ý của thày luôn, thày cho nhà em "cắp tráp " theo hầu , được không ạ ? Tiếc thật, nếu ở gần , dứt khoát nhà em đến thăm hầu chuyện thầy một hôm .Xin cám ơn thày !
Upvote
0
