iT邦幫忙

0

excel自動跳出圖片

拜託各位大大

問題1:
已經用vlookup讓打出編號即可跳出產品名稱
現在想要用利用產品編號跳出產品照片
該怎麼使用

問題2:
下拉選單想要可以搜尋關鍵字選取的
該怎麼設定

看更多先前的討論...收起先前的討論...
二個問題就分別發二個文。
以利未來其他人搜尋。
ccutmis iT邦高手 2 級 ‧ 2019-10-02 17:00:55 檢舉
VBA Popup Pictures 9002年的影片...
https://www.youtube.com/watch?v=06LK92YY0gc
yes00999 iT邦新手 5 級 ‧ 2019-10-02 17:09:44 檢舉
p大 謝謝 下次注意

C大 謝謝你幫忙 但我要的是她秀出在一個儲存格內 不曉得有無此方法
ccutmis iT邦高手 2 級 ‧ 2019-10-02 17:26:58 檢舉
那就只能期待樓下邦友們回覆了 我對EXCEL沒有很熟
giulian iT邦新手 4 級 ‧ 2019-10-03 05:49:34 檢舉
問題一
要秀在儲存格內做得到,但不建議
因為要顯示在儲存格內的話,需要用程式把圖片貼到文件內,比較建議用windows form去做,在執行效能上會比較好一點,你只是需要看照片還是要作成文件用,比如輸入貨號後在另一欄插入圖片,作為盤點對照用。是像這樣的用途嗎?

問題二
有點不大明白你的意思,是指你選一段文字用這段文字去篩選後作成下拉
還是有一個下拉選單,裡面有文字,選了之後篩選儲存格的內容
yes00999 iT邦新手 5 級 ‧ 2019-10-03 14:45:10 檢舉
G 大 : 因為固定照片只有幾張 想要直接跳出在儲存格內 是您說的這樣的用途沒錯!

問題二 : 我已經解決了 感謝你
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

0
giulian
iT邦新手 4 級 ‧ 2019-10-08 03:15:39
最佳解答

做法是這樣
新增一個form跟一個module
在模組中呼叫表單

執行完後就會把圖片插入到指定的欄位

Public Sub ImportPictures()
    Load frmMedia
    frmMedia.Show
End Sub

表單組成跟選項是這樣做
https://ithelp.ithome.com.tw/upload/images/20191008/20115027OeiHl2U9i3.png

中間的相關參數看你自己設定

表單程式


'關閉按鈕
Private Sub ImportClose_Click()
    Me.Hide
    Unload Me
End Sub

'執行按鈕
Private Sub ImportStart_Click()
    On Error Resume Next
    Dim sFilename As String, sSize As String
    Dim sArticleColumn As String, sPictureColumn As String
    Dim iRowHeight As Integer, iColumnWidth As Integer, iEmpty As Integer, iShapes As Integer, iAnz As Integer
    Dim basePath As String, picFormat As String
    
    
    basePath = "貨號圖片的路徑"
    picFormat = ".png" '圖片副檔名
    
    iShapes = ActiveSheet.Shapes.Count
    
    If ActiveSheet.ProtectDrawingObjects = True Or ActiveSheet.ProtectContents = True Or ActiveSheet.ProtectScenarios = True Then
        MsgBox "資料表保護中請移除或確定權限!", vbInformation, "圖片插入工具"
        Exit Sub
    End If
    If optSizeSmall.Value = True Then
        sSize = "s"
        iRowHeight = 3 * 29.5               '100 Pixel ^ 3 cm
        iColumnWidth = -0.71 + 5.1425 * 3   '100 Pixel ^ 3 cm
    ElseIf optSizeMedium.Value = True Then
        sSize = "m"
        iRowHeight = 6 * 29.5               '240 Pixel ^ 6 cm
        iColumnWidth = -0.71 + 5.1425 * 6   '240 Pixel ^ 6 cm
    ElseIf optSizeLarge.Value = True Then
        sSize = "l"
        iRowHeight = 10 * 29.5              '360 Pixel ^ 10 cm
        iColumnWidth = -0.71 + 5.1425 * 10  '360 Pixel ^ 10 cm
    ElseIf optSizeOffice.Value = True Then
        sSize = "o"
        iRowHeight = 0                      'various sizes
        iColumnWidth = 0                    'various sizes
    ElseIf optSizeLineDrawing.Value = True Then
        sSize = "d"
        iRowHeight = 0                      'various sizes
        iColumnWidth = 0                    'various sizes
    End If

        '資料檢查
        '這段是確認使用者輸入的欄位,有部分欄位要配合公司內部其他部門使用,會限制範圍 
        '這段是確認要插入圖片的欄位
   
    sArticleColumn = UCase(Trim(txtArticleNrColumn.Text))
    sPictureColumn = UCase(Trim(txtPictureColumn.Text))
    
    If optSizeFitPicture.Value = True Then
        Range(sPictureColumn & ":" & sPictureColumn).Columns.ColumnWidth = iColumnWidth
    End If
    For i = 1 To 10000 '限制最多只能插入多少
        If Trim(Range(sArticleColumn & CStr(i)).Text) = "" Or IsEmpty(Trim(Range(sArticleColumn & CStr(i)).Text)) Then
            iEmpty = iEmpty + 1
            If iEmpty > 5 Then GoTo FINISH
        Else
            iEmpty = 0
            sBildname = Trim(Replace(Trim(CStr(Range(sArticleColumn & CStr(i)))), " ", ""))
                
                '這段你自己處理,通常是做基本的貨號格式確認,避免抓不到檔案
            
                sFilename = basePath & sBildname & picFormat
                If optSizeFitPicture.Value = True Then ActiveSheet.Rows(i).RowHeight = iRowHeight
                InsertPicture sFilename, sBildname, Range(sPictureColumn & CStr(i)), False, True
            
        End If
    Next
FINISH:
    Cells(1, 1).Select
    iAnz = ActiveSheet.Shapes.Count - iShapes
    MsgBox CStr(iAnz) & " 圖片插入完成!", vbInformation, "圖片插入工具"
    frmMedia.Hide
    Unload frmMedia
    On Error GoTo 0
End Sub

'圖片插入程式
Private Sub InsertPicture(PictureFileName As String, ByVal Bildname As String, TargetCell As Range, _
                          CenterH As Boolean, CenterV As Boolean)
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    
    p.Name = Bildname & "jpeg"
    With TargetCell
        .Value = sBildname
        p.Height = TargetCell.Height
        p.Width = TargetCell.Width
        t = .Top
        l = .Left
        If CenterH Then
            w = .Offset(0, 1).Left - .Left
            l = l + w / 2 - p.Width / 2
            If l < 1 Then l = 1
        End If
        If CenterV Then
            h = .Offset(1, 0).Top - .Top
            t = t + h / 2 - p.Height / 2
            If t < 1 Then t = 1
        End If
    End With
    With p
        .Top = t
        .Left = l
    End With
    
   Set p = Nothing
End Sub
yes00999 iT邦新手 5 級 ‧ 2019-10-14 13:46:20 檢舉

謝謝大大 我已解決啦~~~

我要發表回答

立即登入回答