Note: The other languages of the website are Google-translated. Back to English
Մուտք  \/ 
x
or
x
Գրանցում  \/ 
x

or

Ինչպե՞ս վերանվանել բոլոր պատկերների անունները թղթապանակում ՝ համաձայն Excel- ի բջիջների ցուցակի:

Երբևէ փորձե՞լ եք վերանվանել նկարները ՝ համաձայն թերթիկում նշված բջիջների ցուցակի: Եթե ​​այո, ապա հնարքներ ունե՞ք գործն արագ կարգավորելու, առանց դրանց հերթով վերանվանելու: Այս հոդվածում ես ներկայացնում եմ երկու VBA կոդ Excel- ում այս աշխատանքը արագ կարգավորելու համար:

Վերանվանել բոլոր պատկերների անունները պանակում


Վերանվանել բոլոր պատկերների անունները պանակում

Նշված պանակում բոլոր պատկերների անունները վերանվանելու համար նախ պետք է թերթում նշեք բնօրինակ անունները:

1. Մամուլ Alt + F11 ստեղները ՝ Microsoft Visual Basic հավելվածների համար պատուհան.

2: սեղմեք Տեղադրել > Մոդուլներ և ներքևում տեղադրեք կոդը սցենարում:

VBA. Ստացեք պանակի նկարների անուններ

Sub PictureNametoExcel()
'UpdatebyExtendoffice201709027
    Dim I As Long
    Dim xRg As Range
    Dim xAddress As String
    Dim xFileName As String
    Dim xFileDlg As FileDialog
    Dim xFileDlgItem As Variant
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a cell to place name list:", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xRg = xRg(1)
    xRg.Value = "Picture Name"
    With xRg.Font
    .Name = "Arial"
    .FontStyle = "Bold"
    .Size = 10
    End With
    xRg.EntireColumn.AutoFit
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    I = 1
    If xFileDlg.Show = -1 Then
        xFileDlgItem = xFileDlg.SelectedItems.Item(1)
        xFileName = Dir(xFileDlgItem & "\")
        Do While xFileName <> ""
            If InStr(1, xFileName, ".jpg") + InStr(1, xFileName, ".png") + InStr(1, xFileName, ".img") + InStr(1, xFileName, ".ioc") + InStr(1, xFileName, ".bmp") > 0 Then
                xRg.Offset(I).Value = xFileDlgItem & "\" & xFileName
                I = I + 1
            End If
            xFileName = Dir
        Loop
    End If
    Application.ScreenUpdating = True
End Sub

3. Մամուլ F5 Կոդը գործարկելու համար ստեղն է, և դուրս է գալիս երկխոսություն ՝ հիշեցնելու համար, որ ընտրեք բջիջ ՝ անվանացանկը դուրս բերելու համար: Տեսեք,
փաստաթուղթը վերանվանել նկարը թղթապանակում 1

4: սեղմեք OK և ընտրելու համար նշված թղթապանակը, որի նկարի անունները պետք է նշեք ընթացիկ աշխատանքային թերթում: Տեսեք,
փաստաթուղթը վերանվանել նկարը թղթապանակում 2

5: սեղմեք OK, Նկարի անունները նշված են ակտիվ թերթիկի վրա:

Դրանից հետո կարող եք վերանվանել նկարները:

1. Մամուլ Alt + F11 ստեղները ՝ Microsoft Visual Basic հավելվածների համար պատուհան.

2: սեղմեք Տեղադրել > Մոդուլներ և ներքևում տեղադրեք կոդը սցենարում:

VBA. Ձեռք բերեք վերանվանեք նկարներ

Sub RenameFile()
'UpdatebyExtendoffice20170927
    Dim I As Long
    Dim xLastRow As Long
    Dim xAddress As String
    Dim xRgS, xRgD As Range
    Dim xNumLeft, xNumRight As Long
    Dim xOldName, xNewName As String
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRgS = Application.InputBox("Select Original Names(Single Column):", "KuTools For Excel", xAddress, , , , , 8)
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Application.InputBox("Select New Names(Single Column):", "KuTools For Excel", , , , , , 8)
    If xRgD Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    xLastRow = xRgS.Rows.Count
    Set xRgS = xRgS(1)
    Set xRgD = xRgD(1)
    For I = 1 To xLastRow
        xOldName = xRgS.Offset(I - 1).Value
        xNumLeft = InStrRev(xOldName, "\")
        xNumRight = InStrRev(xOldName, ".")
        xNewName = xRgD.Offset(I - 1).Value
        If xNewName <> "" Then
            xNewName = Left(xOldName, xNumLeft) & xNewName & Mid(xOldName, xNumRight)
            Name xOldName As xNewName
        End If
    Next
    MsgBox "Congratulations! You have successfully renamed all the files", vbInformation, "KuTools For Excel"
    Application.ScreenUpdating = True
End Sub

3. Մամուլ F5 Կոդը գործարկելու համար ստեղն է, և դուրս է գալիս երկխոսություն ՝ հիշեցնելու ձեզ ընտրել նկարների բնօրինակ անունները, որոնք ցանկանում եք փոխարինել: Տեսեք,
փաստաթուղթը վերանվանել նկարը թղթապանակում 3

4: սեղմեք OKև ընտրեք նոր անունները, որոնք ցանկանում եք փոխարինել նկարների անունները երկրորդ երկխոսության շրջանակներում: Տեսեք,
փաստաթուղթը վերանվանել նկարը թղթապանակում 4

5: սեղմեք OK, բացվում է երկխոսություն ՝ հիշեցնելու համար, որ նկարի անունները հաջողությամբ փոխարինվել են:
փաստաթուղթը վերանվանել նկարը թղթապանակում 5

6. Կտտացրեք OK- ին և նկարի անունները փոխարինվեցին թերթի բջիջներով:

փաստաթուղթը վերանվանել նկարը թղթապանակում 6
doc սլաքը ներքև
փաստաթուղթը վերանվանել նկարը թղթապանակում 7

Հարաբերական հոդվածներ:


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel- ի համար նախատեսված Kutools- ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80% -ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ, Աջակցում է Office / Excel 2007-2019 և 365. Աջակցում է բոլոր լեզուները: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հատկություններ ՝ 30-օրյա անվճար փորձաշրջան: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր կտտոցները ձեզ համար ամեն օր:
officetab ներքևում
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Sam Jones · 3 years ago
    Hi, i've tried using this however running the 'PictureNametoExcel' macro only returns the first photo file path name. The other photos in the folder wont be listed. Any help would be greatly appreciated.

    Side note: I've tested the 'RenameFile' Macro and that works perfectly

    Thanks
    Sam
    • To post as a guest, your comment is unpublished.
      Dunmoye · 1 years ago
      Hi Sam, Select the cell range. I guess this is as a result of you selecting just one cell