Just nu i M3-nätverket
Gå till innehåll
Freppa87

Kopiera färgläggning från bladx till blad1

Rekommendera Poster

Hej,

 

jag har x antal flikar där jag har olika färgscheman på kolumnerna. Jag tycker det är rörigt att behöva gå igenom varje enskild flik för att få fram dessa.

Min tanke är att jag har gjort en summeringsflik (blad1) som har Variabler i y-led och fliknamn i x-led.

 

Jag har försökt anpassa denna koden men får att att indexet är utanför intervall.

 


      Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 2 To WS_Count

            
           
        Worksheets("Blad" & I).Range("A2:A31").Interior.Color = Worksheets("Blad1").Range("B2:B31").Interior.Color


         Next I

      End Sub
 

 

Jag har fortfarande inte löst hur jag skall göra för att ändra rangen för andra Range satsen, då den skall även skall stega ett steg per iteration.

 

//Fredrik

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

OFFSET  med (i-2) raders förskjutning

Worksheets("Blad" & I).Range("A2:A31").Interior.Color = _

Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Interior.Color

 

Men(1) den här raden hämtar färg FRÅN blad1 TILL blad x, dvs tvärs emot vad du säger i rubriken (det som står till vänster om "= " tilldelas ju värdet/egenskapen)

Om rubriken stämmer vill du ha:

Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Interior.Color= _

Worksheets("Blad" & I).Range("A2:A31").Interior.Color 

 

Men(2) VBA kommer bara att hämta color-koden från den första cellen till höger om likhetstecknet.  Om du har blandade färger så verkar den göra något slag summering/0-ställning så att färgen blir svart .

Om du har flera olika färger på ett blad/kolumn kan du köra en "inre" loop som går igenom varje cell istället för att försöka kopiera områdets formatering:


 

DIM x As integer

For I = 2 To WS_Count
    For x = 2 To 31
        Worksheets("Blad" & I).Range("A2:A31").Cells(x).Interior.Color = _
        Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Cells(x).Interior.Color
    Next x
Next I

 

 

 

För att kopiera områdets formatering  kan du köra klassisk klistra in special-format:
 

For I = 2 To WS_Count
        Worksheets("Blad1").Range("B2:B31").Offset(rowOffset:=0, columnOffset:=(I - 2)).Copy
        Worksheets("Blad" & I).Range("A2:A31").PasteSpecial Paste:=xlPasteFormats
Next I

hämtar från blad i och kopierar till blad x. Vänd på koden vid behov.

För en gångs skull rekommenderar jag att du kör en select någonstans i koden. Annars kan "Paste"  hamna lite varsomhelst om du har en markering när du påbörjar makrot. 

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Skapa ett konto eller logga in för att kommentera

Du måste vara medlem för att kunna kommentera

Skapa ett konto

Skapa ett nytt konto på vårt forum. Det är lätt!

Registrera ett nytt konto

Logga in

Redan medlem? Logga in här.

Logga in nu



  • Liknande Innehåll

    • Av MvS
      Jag har gjort en databas i Excel 2013 åt en kompis för hans stora skivsamling. Jag försöker att skapa ett automatiserat flöde där det enkelt ska gå att skriva ut etiketter ur samlingen att fästa på hyllor och lådor där skivorna förvaras. För detta ändamål har jag skapat tre etikettmallar i Word för olika tidsperioder (Mall 1 = 1950 - 1970. mall 2 = 1970 - 1990, mall 3 = Från 1990) som kan användas att märka upp de många lådor som skivsamlingen finns i.
      Jag har försökt hitta VBA-kod som kan bistå med detta så att man bara behöver klicka på en knapp i Excel-databasen för att automatiskt skapa en etikettserie  i Word (mailmerge). Det verkar funka så långt att Word öppnar och påbörjar mailmerge med sen hänger sig programmet i flera minuter och Word kraschar. 
      Så här ser min kod ut för första tidspannet (1950-1970):
      Private Sub Document_Open() Dim wd As Object Dim wDocSource As Object, wDocPath As String Dim strWorkbookName As String Set wDocSource = ThisDocument wDocPath = ThisDocument.Path strWorkbookName = wDocPath & "\Etiketter+Db.xlsm" On Error Resume Next Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") End If On Error GoTo 0 wDocSource.MailMerge.OpenDataSource Name:= _ strWorkbookName, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:="SELECT * FROM `Db$`" With wDocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument ChangeFileOpenDirectory _ wDocPath ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15 End Sub Då jag kapar sekvensen efter SQLStatement  (i.e. INNAN begäran om att fullfölja mailmerge) så verkar det gå bra, men då måste man "manuellt" välja "Slutför och koppla" för att etikettserien ska genereras och jag vill att hela processen ska funka automatiskt så att det bara är för användaren att skriva ut! Grunddelen av VBA-koden ovan har jag fått genom en makroinspelning och sedan har jag lagt till delar jag hittat på nätet. En märklig sak dock är att själva filtreringen jag gör underinspelningen i "Redigera mottagarlista" kommer av någon anledning inte med i koden - varför då?
      Jag har också prövat att lägga in "WHERE" argument i SQL-statement efter tips när jag Googlat runt men då hittar inte Word sökvägen till Excel-filen och dokumentet kan inte öppna!
      Känner spontant att detta bara måste funka men antagligen är det något knas med kodningen som ställer till det. Om det finns någon i forumet som har råkat ut för motsvarande och till äventyrs hittat en bra lösning vore jag stort tacksam för hjälp!
       
       
    • Av MvS
      Hej alla Excelkunniga!
      Har ett problem jag inte kan förstå hur det ska lösas. Har gjort en inventeringslista i Excel som jag vill kunna skriva ut etiketter på olika poster. Etiketterna kan ha tre olika symboler (bilder) i sig beroende på om posten skapades före ett visst årtal, mellan två år eller efter ett tredje årtal. Så jag har skapat tre wordmallar som jag vill anropa vid etikettutskrift från min Excelfil. Har snokat runt webben och landat i ett VBA-skript som verkade kunna göra jobbet. Jag har med mina något rudimentära kunskaper i VBA försökt anpassa skriptet att öppna beroende på vad man anger via en  combobox: Före 1994, mellan 1994-2011 samt efter 2011.
      Jag har använt case-anrop för kommandona (se skript nedan) men när jag försöker köra det så öppnar Excel visserligen rätt Worddokument men skriptet stannar sedan och felmeddelande visas:

       
      Har prövat att modda skriptet på olika sätt, googlat efter lösning på problemet men inte lyckats finna vad som fattas. Nu står mitt sista hopp till om någon VBA-kunnig på Eforum kan hjälpa mig.
      Sub Etiketter() Call TaBortSkydd Dim ws As Worksheet Dim Opt As Integer, Result As Action Dim objWord As Object Set ws = ActiveSheet Opt = ws.Range("$O$1").Value Set objWord = CreateObject("Word.Application") objWord.Visible = True Select Case Opt Case Is = 1 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_1.docx") Case Is = 2 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_2.docx") Case Is = 3 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_3.docx") End Select ws.Range("$O$1").ClearContents Call Workbook_RefreshAll Call SkyddaBlad End Sub Med hopp om räddning...
    • Av MvS
      Jag har en matrikel där jag har infogat en tidstämpelfunktion som har funkat hyggligt men nu krånglar. 
      Har prövat lite olika varianter men får vid varje uppdatering upp en dialogruta med "Ogiltigt proceduranrop eller argument". (Se bifogad bild.)
      Det är ett enkelt skript men jag blir inte klok på vad som felas - någon som vet bättre än mig? 
      Bifogar skriptet som txt-fil!
       

      VBA Timestamp.txt
       
      Infogar texten direkt, förenklar kanske lite:
      Private Sub Worksheet_Change(ByVal Target As Range) Call Modul1.TaBortSkydd Application.EnableEvents = False ActiveSheet.ListObjects("Tabell2").Range.Select With Selection If Target.Column <= 13 Or Target.Column >= 15 Then Range("N" & Target.row).Value = Date End If End With Application.EnableEvents = True Call Modul1.Skydd End Sub /Mikael63, moderator
    • Av MvS
      Jag har en medlemsmatrikel på ett Excel-ark där jag behöver en funktion (ett Makro) som kan exportera medlemmars namn tillsammans med respektive epost-adress till en text-fil. 
      Har kollat runt men inga exempel jag stött på verkar fungera så jag undrar nu om det finns någon vänlig själ som kan hjälpa mig?
      Jag vill kunna exportera innehållet i kolumn "A" (Namn) och kolumn "J" (E-postadress) men bara från de rader där medlemmen har en epostadress. Utdata på textfilen bör vara tabbavgränsat men det  är inget absolut måste...
      Pls help...
       
    • Av MvS
      Hej!
      Har nu suttit och dammsugit webben efter lättbegripliga exempel på hur man skapar en mall i Word som uppdateras med vba-formulär utan någon större framgång.
      Är inte bra alls på vba och söker efter ett konkret exempel på kodsnuttar att använda för att designa en dokumentmall där en användare som ska skapa ett nytt dokument först får upp en dialogruta där rubrik, underrubrik, författare och datum matas in och att sedan mallen öppnar med dessa värden ifyllda på rätt ställen i mallen.
      Jag har fattat så pass att detta detta görs bäst med vba-kod som kopplas mot bokmärken i dokumentet. Kom så långt att jag designade ett formulär i VBA-editorn men når inte ända fram med kodningen mot bokmärkena. Se bifogad bild.
      Anybody?

  • Senaste som Tittar

    Inga registrerade medlemmar är inne på denna sida.

  • Obesvarade ämnen

  • Nya ämnen

×
×
  • Skapa nytt...