Xin giúp mình chèn hình ảnh hàng loạt và tên hình ảnh

[huonglan9x]

- Xin mọi người giúp đõ , tình hình là em muốn làm một bản danh sách hàng hoá bằng hình ảnh “ như hình bên dưới”, nhưng em mù excel “ Vì không phải chuyên môn” nên làm thủ công chứ kéo thả từng hình, rồi đánh tên cho từng loại , làm lâu mà cũng không có hiệu quả, vì sau này sẽ cần dùng đến nó dài dài. Em nhờ mọi người giúp em ạ …
Ảnh em làm thủ công …. Phần màu sắc - mã sản phẩm và kiểu máy em có thể tự nhập tay. em cần giúp phần hình sản phẩm và tên sản phẩm thôi ạ.
<div></div>

View more random threads:

• Định dạng Font size trong word theo điều kiện
• Tìm kiếm tên của người có số ngày lớn nhất
• Fonts Excel bị lỗi không đọc được chữ nào cả.
• Nhờ anh em, thầy cô giải thích giúp em lỗi này
• [Hỏi ngu] bác nào biết làm thế nào tạo 1 dãy số ngẫu nhiên mà trung bình bằng 1 số ạ?
• Kiểm tra sự tồn tại của 1 file trong Excel sử dụng hàm tự tạo trong VBA
• làm thế nào để chích 1 or 2 or 3 kí tự cùng 1 lúc.
• Tìm giá trị theo nhiều điều kiện
• Lấy kí tự là số trong các chuỗi text
• Chọn mã tỉnh, huyện, xã

[bocghenem]

không ai giúp em ạ [IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG]

[nguyennguyet]

Dạ đúng thứ em cần rồi anh , anh có thể giúp em thêm 1 chút không anh. Em muốn cái phần hình ảnh nó to ra thệm thì làm cách nào ạ, với phần tên bỏ đi cái định dạng của file ảnh "abcz.jpg" em muốn bỏ phần định dạng của file ảnh đi chỉ còn tên thôi dc không Anh

Bạn thay toàn bộ code bài trên thành code sau nhé:

Option ExplicitSub Main()  Dim vFile, picItem  Dim path As String, ret As String  Dim rng As Range  Dim n As Long  vFile = Application.GetOpenFilename("Image Files, *.bmp;*.jpg;*.png", , , , True)  If IsArray(vFile) Then    Set rng = Sheet1.Range("E60000").End(xlUp).Offset(1)    For Each picItem In vFile      path = CStr(picItem)      ret = Pic2Comment(path, rng.Offset(n, -2))      rng.Offset(n, 0).Value = ret      n = n + 1    Next  End IfEnd SubPrivate Function Pic2Comment(ByVal path As String, ByVal cel As Range) As String  Dim fso As Object  On Error Resume Next  Set fso = CreateObject("Scripting.FileSystemObject")  With cel    .ClearComments    If fso.FileExists(path) Then      .AddComment: .Comment.Visible = True      With .Comment.Shape        .Shadow.Visible = msoFalse        .Line.ForeColor.RGB = vbWhite        .AutoShapeType = msoShapeRectangle        .Left = cel.Left: .Top = cel.Top        .Width = cel.Width: .Height = cel.Height         .ScaleWidth 1, msoFalse, msoScaleFromMiddle    ' Chinh độ rộng của ảnh ở đây         .ScaleHeight 1, msoFalse, msoScaleFromMiddle   ' Chỉnh độ cao của ảnh ở đây        .Fill.UserPicture path      End With      If Err.Number = 0 Then         Pic2Comment = fso.GetBaseName(path)        'Pic2Comment = fso.GetFile(path).Name      Else        cel.Comment.Delete      End If    End If  End WithEnd FunctionSub DelComm()  Sheet1.Range("C5:C60000").ClearCommentsEnd Sub  

Chỗ tô màu đỏ là chỗ tôi có chỉnh lại theo yêu cầu của bạn.
Chi tiết, bạn xem file đính kèm nhé.

[linhti0209]

không ai giúp em ạ [IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG][IMG]images/smilies/a36.gif[/IMG]

File chẳng có, chỉ nói không không thì giúp bằng cách nào?

[leotran]

Bạn thay toàn bộ code bài trên thành code sau nhé:

<div class="bbcode_container">
<div class="bbcode_description">Code:

</div>
</div>
Nếu ScaleWidth 1... và ScaleHeight 1... thì hình thể hiện trên cell sẽ rất xấu, nó che mất Border trên bảng tính. Dù có tăng hình to lên thì cùng lắm sửa chỗ màu đỏ cở 0.9 là vừa đẹp lắm rồi
Muốn hình to thêm nữa, hãy chỉnh độ rộng cột và độ cao dòng trước khi chạy code (thay vì chỉnh size hình)

[trinhhiep.camera]

Dạ em xin cảm ơn 2 anh đã nhiệt tình giúp em , [IMG]images/smilies/a30.gif[/IMG] đúng thứ em cần làm luôn hihi

[sarahbig]

Cho em hỏi thệm 1 vấn đề ạ, khi em copy ra 1 sheet mới thì cái code nó ko chạy ạ , vì mỗi sheet là 1 thương hiệu riêng, khi qua sheet khác em run code thì nó lại chạy vào sheet ban đầu [IMG]images/smilies/a25.gif[/IMG]

[congthuonghcit]

Cho em hỏi thệm 1 vấn đề ạ, khi em copy ra 1 sheet mới thì cái code nó ko chạy ạ , vì mỗi sheet là 1 thương hiệu riêng, khi qua sheet khác em run code thì nó lại chạy vào sheet ban đầu [IMG]images/smilies/a25.gif[/IMG]

Trong code code đoạn:

 Set rng = Sheet1.Range("E60000").End(xlUp).Offset(1)

Cái màu đỏ là TÊN SHEET, chỗ màu xanh là CỘT DỮ LIỆU, hãy sửa lại cho phù hợp
Tuy nhiên, khuyên bạn không nên copy tùm lum ra nhiều sheet. Đây là hình ảnh, copy nhiều sẽ khiến cho file bạn rất nặng đấy
(thà chia thành nhiều file còn tốt hơn)

[lucbeo]

File chẳng có, chỉ nói không không thì giúp bằng cách nào?

Dạ anh , hehe em quên cái vụ này, vì gà excel lắm[IMG]images/smilies/a25.gif[/IMG]. Em là KTV làm ĐTDĐ. Mà giờ phải làm cái này nên cũng gà mờ[IMG]images/smilies/a42.gif[/IMG]
Em chỉ cần cột hình sản phẩm - và tên sản phẩm. Hình em để tên khi làm thì tên của cái hình nó sẽ là tên của sản phẩm thôi, còn mấy cái như loại máy, màu, giá cái đó chắc phải làm thủ công rồi hihi... mẫu bên dưới của em làm 1 cái bằng thủ công, kéo hình thả vào rồi điều chỉnh kích thước bằng tay mọi thứ đều làm thủ công hix
link 1 số ảnh sp : http://www.mediafire.com/download/5p...%82%CC%83u.zip

[skysofa]

Dạ anh , hehe em quên cái vụ này, vì gà excel lắm[IMG]images/smilies/a25.gif[/IMG]. Em là KTV làm ĐTDĐ. Mà giờ phải làm cái này nên cũng gà mờ[IMG]images/smilies/a42.gif[/IMG]
Em chỉ cần cột hình sản phẩm - và tên sản phẩm. Hình em để tên khi làm thì tên của cái hình nó sẽ là tên của sản phẩm thôi, còn mấy cái như loại máy, màu, giá cái đó chắc phải làm thủ công rồi hihi... mẫu bên dưới của em làm 1 cái bằng thủ công, kéo hình thả vào rồi điều chỉnh kích thước bằng tay mọi thứ đều làm thủ công hix
link 1 số ảnh sp : http://www.mediafire.com/download/5p...%82%CC%83u.zip

Nói trước: Bài này chỉ có thể giải quyết bằng phương pháp lập trình VBA mà thôi. Nếu bạn đồng ý thì tôi làm như sau:
1> Code trong module

Sub Main()
  Dim vFile, picItem
  Dim path As String, ret As String
  Dim rng As Range
  Dim n As Long
  vFile = Application.GetOpenFilename("Image Files, *.bmp;*.jpg;*.png", , , , True)
  If IsArray(vFile) Then
    Set rng = Sheet1.Range("E60000").End(xlUp).Offset(1)
    For Each picItem In vFile
      path = CStr(picItem)
      ret = Pic2Comment(path, rng.Offset(n, -2))
      rng.Offset(n, 0).Value = ret
      n = n + 1
    Next
  End If
End Sub
Function Pic2Comment(ByVal path As String, ByVal cel As Range) As String
  Dim fso As Object
  On Error Resume Next
  Set fso = CreateObject("Scripting.FileSystemObject")
  With cel
    .ClearComments
    If fso.FileExists(path) Then
      .AddComment: .Comment.Visible = True
      With .Comment.Shape
        .Shadow.Visible = msoFalse
        .Line.ForeColor.RGB = vbWhite
        .AutoShapeType = msoShapeRectangle
        .Left = cel.Left: .Top = cel.Top
        .Width = cel.Width: .Height = cel.Height
        .ScaleWidth 0.7, msoFalse, msoScaleFromMiddle
        .ScaleHeight 0.7, msoFalse, msoScaleFromMiddle
        .Fill.UserPicture path
      End With
      If Err.Number = 0 Then
        Pic2Comment = fso.GetFile(path).Name
      Else
        cel.Comment.Delete
      End If
    End If
  End With
End Function

2> Cách dùng
- Mở file đính kèm
- Bấm nút Run code ---> Một cửa sổ chọn file hiện ra ---> Hãy duyệt đến thư mục chưa hình trên máy bạn
- Dùng chuột chọn file hình. Có thể kết hợp chuột với phím Shift hoặc Ctrl để chọn nhiều hình cùng lúc
- Bấm nút 'Open', lập tức hình sẽ được chèn vào bảng tính
--------------------------
Việc của bạn là: Biết cách Enable Macros để có thể dùng được code VBA