Question

我正在尝试编写一个代码，我在检查工作簿的每张工作表中的信息后输入图像。由于我为每个代码添加了它停止工作并开始给我这个编译错误消息，代码工作没有为每个但我希望它是自动的。你们可以帮忙吗？

PT-BR：Estou tentando montarumcódigondeele verificar todas as planilhas e insere a imagem conforme os dados emdeterminadacélula。 Ocódigofuncionasem o loop mas quero que sejatodoautomáticoedesde que inclui o For Each aparece esse errodecompilação。 Se puderem me ajudar com o que setrataagradeço。

Sub ForEachWs()
Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
    Call Worksheet_SelectionChange
    Next ws

End Sub

Sub Worksheet_SelectionChange(ByVal Target As Range)

   On Error Resume Next

    If Target.Column = 2 And Target.Row = 1 Then ' onde clicar para buscar imagem

        BuscarImagemTavares (Target.Value)

    End If

End Sub

Sub BuscarImagemTavares(Produto As String)
    On Error Resume Next
    'Autor: Tavares

    If Range("B2") = "ok" Then 'Verifica se celula B2 tem ok se sim não insere a imagem novamente
    Exit Sub
    End If

    Dim Imagem, CaminhoImagem As String

    If Len(Produto) = 3 Then 'acrescenta 00 antes do cod do produto
        Produto = "00" & Produto
    End If
    If Len(Produto) = 4 Then 'acrescenta 0 antes do cod do produto
        Produto = "0" & Produto
    End If

    Imagem = Dir("\\Clfssrvfar\ENGENHARIA\GESTAO_DE_PROJETOS\04. FOLLOWUP\09. ARQUIVOS PARA FERRAMENTAS\09.1 IMAGENS\09.1.2 IMAGENS PRODUTOS\" & Produto & "*", vbDirectory)

    CaminhoImagem = "\\Clfssrvfar\ENGENHARIA\GESTAO_DE_PROJETOS\04. FOLLOWUP\09. ARQUIVOS PARA FERRAMENTAS\09.1 IMAGENS\09.1.2 IMAGENS PRODUTOS\" & Imagem



    With ActiveSheet.Pictures.Insert(CaminhoImagem) 'Mostra Imagem
        'Define tamanho e posição da imagem

    With .ShapeRange
        .Width = 75
        .Height = 115
        .Top = 7
        .Left = 715
        '*above it's me trying to make white background transparent*
            'With .PictureFormat
            '.TransparentBackground = True
            '.TransparencyColor = RGB(255, 0, 0)
            'End With
        '.Fill.Visible = True
        'End With
        'ActiveSheet.Shapes.Range(Array("Picture 2")).Select
        'Application.CommandBars("Format Object").Visible = False
    End With
    End With
    If CaminhoImagem <> "" Then 'Após inserir imagem informa "ok" na B2 para não inserir de novo
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "OK"
    End If

End Sub

Answer 1

您正在调用Event-Routine import * as React from "react"; var $: any = $; export interface IProps { givenId: string; specialType: string; inputValue?: string; updateModel: Function; } export default class SearchSelectFormElem extends React.Component<IProps, { selectNode: any }> { private searchSelect: HTMLSelectElement; showDropdown() { $(this.searchSelect).select2("open"); } componentDidMount() { $(this.searchSelect).select2({ selec2 options }); } render() { let fieldLabel: string = this.props.givenId; fieldLabel = fieldLabel.replace(/([A-Z])/g, ' $1').trim(); return ( <li className="form-list-elem has-special-input dropdown"> <label htmlFor={this.props.givenId} className="form-label"> {fieldLabel} </label> <div className="special-wrapper"> <select ref={(node) => {this.searchSelect = node}} className="form-input main-form-input select2picker search-dropdown" id={this.props.givenId}> <option>{this.props.inputValue}</option> </select> <span className="special-control dropdown" onClick={this.showDropdown.bind(this)}></span> </div> </li> ); } }。当用户更改所选单元格（移动光标）时，这是从Excel自动调用的例程。允许手动调用事件例程，但您必须传递Sub Worksheet_SelectionChange作为参数（表示所选范围），例如：

range

这将满足编译器，但是，为什么不直接调用实际例程：

For Each ws In ActiveWorkbook.Worksheets
    Call Worksheet_SelectionChange(ws.cells(1,2))
Next ws

Answer 2

由于您希望为每个工作表运行子BuscarImagemTavares，因此您必须同时更改子ForEachWs和BuscarImagemTavares。

ForEachWs：

Sub ForEachWs()
    Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        'Here you can directly call the sub without the sub Worksheet_SelectionChange
        Call BuscarImagemTavares(ws, ws.Cells(1,2).Value)
        'in BuscarImagemTavares you´ll need the ws reference to actually work on the right worksheet (otherwise youll always work on the selected one)
    Next ws

End Sub

BuscarImagemTavares：

Sub BuscarImagemTavares(ByVal ws as Worrksheet, Produto As String)
    'Mind the additional parameter 'ws'
    On Error Resume Next
    'Autor: Tavares

    'If Range("B2") = "ok" Then 'Verifica se celula B2 tem ok se sim não insere a imagem novamente
    If ws.Range("B2") = "ok" Then 'Here you actually have to use a reference to the Worksheet you want to use, otherwise alwys the same will be used
        Exit Sub
    End If

    ...

    'You need the reference here as well so you won#t use the same worksheet over and over again
    With ws.Pictures.Insert(CaminhoImagem) 'Mostra Imagem

    ...

    If CaminhoImagem <> "" Then 'Após inserir imagem informa "ok" na B2 para não inserir de novo
        'Range("B2").Select
        'ActiveCell.FormulaR1C1 = "OK"
        'If you don´t actually need the cell in excel to be selected after the programm finished you should´nt use the '.select' and '.selection' instead use this:
        ws.Range("B2").Value= "OK" 'Since you aren´t adding a formula you should address the '.value' property
    End If

    ...

End Sub

希望我能帮助你一点。

编译错误：参数不是可选的vba excel

2 个答案: