Hvordan får man en celle som er 90% den anden 10 %

Er det dette du tænker på?

Public Sub MakeTabel_SplitCell()
  Dim OrigWidth As Long
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:=2, AutoFitBehavior:=False
  With ActiveDocument.Tables(ActiveDocument.Tables.Count)
      With .Cell(2, 2)
        OrigWidth = .Width
        .Split NumColumns:=2
      End With
      .Cell(2, 2).Width = OrigWidth * 0.9
      .Cell(2, 3).Width = OrigWidth * 0.1
  End With
End Sub

Her har du hele kode - jeg skal have den til at skrive ugernr om mandagen helt til højre i feltet - i resten af feltet skal jeg kunne skrive som i de andre dage tirsdag til fredag.

Const SØNDAG = 1
Const MANDAG = 2
Const LØRDAG = 7
Const SKÆRTORSDAG = 1
Const LANGFREDAG = 2
Const PÅSKEDAG = 3
Const PÅSKEDAG2 = 4 ' 2. påskedag
Const BEDEDAG = 5
Const KRISTIHIMMELFARTSDAG = 6
Const PINSEDAG = 7
Const PINSEDAG2 = 8 ' 2. pinsedag

Function WEEKNR(InputDate As Long) As Integer
Dim a As Integer, b As Integer, c As Long, d As Integer
    WEEKNR = 0
    If InputDate < 1 Then Exit Function
    a = Weekday(InputDate, vbSunday)
    b = Year(InputDate + ((8 - a) Mod 7) - 3)
    c = DateSerial(b, 1, 1)
    d = (Weekday(c, vbSunday) + 1) Mod 7
    WEEKNR = Int((InputDate - c - 3 + d) / 7) + 1
End Function




Function glrPåskedag(intYear As Integer) As Variant
    ' Udregner påskedag for et givet årstal
    ' Beregningsmetode ifl. Gauss
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim k As Integer
    Dim p As Integer
    Dim q As Integer
    Dim M As Integer
    Dim n As Integer
    Dim intDay As Integer
    Dim intMonth As Integer

    k = intYear \ 100
    p = (13 + 8 * k) \ 25
    q = k \ 4
    M = (15 - p + k - q) Mod 30
    n = (4 + k - q) Mod 7
    'Debug.Print k, p, q, m, n
    a = intYear Mod 19
    b = intYear Mod 4
    c = intYear Mod 7
    d = (19 * a + M) Mod 30
    e = (2 * b + 4 * c + 6 * d + n) Mod 7

    If d + e <= 9 Then
        intDay = 22 + d + e
        intMonth = 3
    ElseIf (d = 29) And (e = 6) Then
        intDay = 19
        intMonth = 4
    ElseIf (d = 28) And (e = 6) And (a > 10) Then
        intDay = 18
        intMonth = 4
    Else
        intDay = d + e - 9
        intMonth = 4
    End If
    glrPåskedag = DateSerial(intYear, intMonth, intDay)
End Function

Function Helligdag(intYear As Integer, Helligdagstype As Integer) As Variant
   
    ' Returnerer datoen for de forskydelige helligdage.
    ' Helligdagstypen angives med en af de prædefinerede konstanter

    Select Case Helligdagstype
        Case SKÆRTORSDAG
            Helligdag = glrPåskedag(intYear) - 3
        Case LANGFREDAG
            Helligdag = glrPåskedag(intYear) - 2
        Case PÅSKEDAG
            Helligdag = glrPåskedag(intYear)
        Case PÅSKEDAG2
            Helligdag = glrPåskedag(intYear) + 1
        Case BEDEDAG
            Helligdag = glrPåskedag(intYear) + 26
        Case KRISTIHIMMELFARTSDAG
            Helligdag = glrPåskedag(intYear) + 39
        Case PINSEDAG
            Helligdag = glrPåskedag(intYear) + 49
        Case PINSEDAG2
            Helligdag = glrPåskedag(intYear) + 50
    End Select
End Function

Function IsHelligdag(dtmDate As Variant) As Integer
    ' Returnerer TRUE hvis dtmDate er en helligdag
    Dim intYear As Integer
    Dim dtmPåskedag As Variant

    intYear = Year(dtmDate)
    dtmPåskedag = glrPåskedag(intYear)

    Select Case dtmDate - dtmPåskedag
        Case -3, -2, 0, 1, 26, 39, 49, 50
            IsHelligdag = True
        Case Else
            If (Month(dtmDate) = 1) And (Day(dtmDate) = 1) Then
                IsHelligdag = True ' Nytårsdag
            ElseIf (Month(dtmDate) = 5) And (Day(dtmDate) = 1) Then
                IsHelligdag = True ' 1 Maj
            ElseIf (Month(dtmDate) = 6) And (Day(dtmDate) = 5) Then
                IsHelligdag = True ' Grundlovsdag
            ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 25) Then
                IsHelligdag = True ' Juledag
            ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 26) Then
                IsHelligdag = True ' 2. juledag
            End If
    End Select
End Function

Public Sub MakeTabel_SplitCell()
  Dim OrigWidth As Long
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=2, AutoFitBehavior:=False
  With ActiveDocument.Tables(ActiveDocument.Tables.Count)
      With .Cell(2, 2)
        OrigWidth = .Width
        .Split NumColumns:=2
      End With
      .Cell(2, 2).Width = OrigWidth * 0.9
      .Cell(2, 3).Width = OrigWidth * 0.1
  End With
End Sub


Public Sub MAIN()
Dim x
Dim errtext$
Dim maaned
Dim aar
Dim teller
Dim dag
Dim datosn

Dim datolr
Dim dmaaned
Dim temp

ReDim dage__$(7)
dage__$(1) = "S ": dage__$(2) = "M ": dage__$(3) = "T "
dage__$(4) = "O ": dage__$(5) = "T "
dage__$(6) = "F ": dage__$(7) = "L "

ReDim mdr__$(12)
mdr__$(1) = "Januar": mdr__$(2) = "Februar": mdr__$(3) = "Marts"
mdr__$(4) = "April": mdr__$(5) = "Maj": mdr__$(6) = "Juni"
mdr__$(7) = "Juli": mdr__$(8) = "August": mdr__$(9) = "September"
mdr__$(10) = "Oktober": mdr__$(11) = "November": mdr__$(12) = "December"

WordBasic.BeginDialog 630, 122, "Opretter kalender"
    WordBasic.TextBox 305, 24, 160, 18, "kalendernavn$"
    WordBasic.Text 10, 28, 213, 13, "Navnet på kalenderen:", "Tekst1"
   
    WordBasic.TextBox 305, 48, 160, 18, "mdnr$"
    WordBasic.Text 10, 52, 213, 13, "Nummeret på den 1. måned:", "Tekst2"
   
    WordBasic.TextBox 305, 72, 160, 18, "aar$"
    WordBasic.Text 10, 76, 268, 13, "Årstallet, hvor den første måned er:", "Tekst3"
   
    WordBasic.TextBox 305, 96, 160, 18, "antal$"
    WordBasic.Text 10, 100, 115, 13, "Antal måneder:", "Tekst4"
   
    WordBasic.OKButton 521, 21, 88, 21
    WordBasic.CancelButton 521, 48, 88, 21
WordBasic.EndDialog

Dim informationer As Object: Set informationer = WordBasic.CurValues.UserDialog

start:
x = WordBasic.Dialog.UserDialog(informationer, 1)
On Error GoTo -1: On Error GoTo slut
If x = 0 Then GoTo slut

'Checker dataene fra dialogboksen
If WordBasic.Val(informationer.mdnr$) < 1 Then
    errtext$ = "Månedsnummer skal være større end 0"
    GoTo fejl
End If
If WordBasic.Val(informationer.mdnr$) > 12 Then
    errtext$ = "Månedsnummer skal være mindre end eller lig 12"
    GoTo fejl
End If
If WordBasic.Val(informationer.aar$) < 1900 Then
    errtext$ = "Makroen kan ikke håndtere årstal før 1900"
    GoTo fejl
End If
If WordBasic.Val(informationer.aar$) > 4000 Then
    errtext$ = "Makroen kan ikke håndtere årstal større end 4000"
    GoTo fejl
End If
If WordBasic.Val(informationer.antal$) < 1 Then
    errtext$ = "Antallet af måneder skal være større end 0"
    GoTo fejl
End If
If WordBasic.Val(informationer.antal$) > 12 Then
    errtext$ = "Makroen kan maksimalt håndtere 12 måneder"
    GoTo fejl
End If




WordBasic.Bold 1
WordBasic.Insert informationer.kalendernavn$

WordBasic.TableInsertTable ConvertFrom:="", NumColumns:=Str(WordBasic.Val(informationer.antal$) * 2), NumRows:="33", InitialColWidth:="Auto", Format:="16", Apply:="1"

maaned = WordBasic.Val(informationer.mdnr$)
aar = WordBasic.Val(informationer.aar$)


For teller = 1 To WordBasic.Val(informationer.antal$)
   
    WordBasic.TableSelectColumn
    WordBasic.TableColumnWidth ColumnWidth:="1,5 cm", RulerStyle:="2"
    WordBasic.CharLeft 1
    WordBasic.CharRight 2, 1
    WordBasic.TableMergeCells
    WordBasic.CharLeft 1
    WordBasic.EditBookmark Name:="her", SortBy:=0, Add:=1
   
    WordBasic.Bold 1
    WordBasic.Insert Str(aar)
    WordBasic.Bold 0
    WordBasic.WordLeft 1
    WordBasic.LineDown 1
    WordBasic.CharRight 2, 1
    WordBasic.TableMergeCells
   
   
    WordBasic.ShadingPattern 6
    WordBasic.Bold 1
    WordBasic.Insert mdr__$(maaned)
   
    WordBasic.Bold 0
    WordBasic.WordLeft 1
    WordBasic.LineDown 1
    dag = 1
    datosn = WordBasic.DateSerial(aar, maaned, dag)
   
   
       
    dmaaned = maaned
    While dmaaned = maaned
       
       
        WordBasic.Insert dage__$(WordBasic.Weekday(datosn))
        WordBasic.FormatTabs Position:="1,1 cm", Align:=2, Leader:=0, Set:=1
        WordBasic.Insert Chr(9)
        WordBasic.Insert Str(WordBasic.Day(datosn))
        WordBasic.BorderRight 0
   
             
        WordBasic.WordRight 1
     
        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        Selection.Font.Bold = wdToggle
        Selection.Font.Size = 8
        Selection.Font.Color = wdColorBlue
       
        WordBasic.WordLeft 1
       
        dtmDate = DateSerial(aar, maaned, dag)
           
        If IsHelligdag(DateSerial(aar, maaned, dag)) Then
          WordBasic.ShadingPattern 4
          WordBasic.WordRight 1
         
           
          Selection.Font.Italic = wdToggle
          Selection.Font.Color = wdColorBlack
          Selection.Font.Size = 8
         
          If ((Month(dtmDate) = 5) And (Day(dtmDate) = 1)) Or ((Month(dtmDate) = 6) And (Day(dtmDate) = 5)) Then
            Selection.Font.Size = 8
          Else
            WordBasic.ShadingPattern 4
          End If
         
          Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
          Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
         
         
          Select Case DateSerial(aar, maaned, dag)
                         
            Case Helligdag(CInt(aar), SKÆRTORSDAG)
                Selection.TypeText Text:="Skærtorsdag"
                WordBasic.WordLeft 2
           
            Case Helligdag(CInt(aar), LANGFREDAG)
                Selection.TypeText Text:="Langfredag"
                WordBasic.WordLeft 2
           
            Case Helligdag(CInt(aar), PÅSKEDAG)
                Selection.TypeText Text:="Påskedag"
                WordBasic.WordLeft 2
           
            Case Helligdag(CInt(aar), PÅSKEDAG2)
                Selection.TypeText Text:="2. Påskedag"
                WordBasic.WordLeft 4
                 
            Case Helligdag(CInt(aar), BEDEDAG)
                Selection.TypeText Text:="St.Bededag"
                WordBasic.WordLeft 4
           
            Case Helligdag(CInt(aar), KRISTIHIMMELFARTSDAG)
                Selection.TypeText Text:="Kr.himmelfartsdag"
                WordBasic.WordLeft 4
               
            Case Helligdag(CInt(aar), PINSEDAG)
                Selection.TypeText Text:="Pinsedag"
                WordBasic.WordLeft 2
           
            Case Helligdag(CInt(aar), PINSEDAG2)
                Selection.TypeText Text:="2. Pinsedag"
                WordBasic.WordLeft 4
                   
            Case Else
             
                If (Month(dtmDate) = 1) And (Day(dtmDate) = 1) Then
                  Selection.TypeText Text:="Nytårsdag"
                ElseIf (Month(dtmDate) = 5) And (Day(dtmDate) = 1) Then
                  Selection.TypeText Text:="1. Maj"
                ElseIf (Month(dtmDate) = 6) And (Day(dtmDate) = 5) Then
                  Selection.TypeText Text:="Grundlovsdag"
                ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 25) Then
                    Selection.TypeText Text:="Juledag"
                ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 26) Then
                    Selection.TypeText Text:="2. Juledag"
                End If
                WordBasic.WordLeft 4
           
           
          End Select
               
        End If
       
       
        Select Case WordBasic.Weekday(datosn)
            Case SØNDAG
                WordBasic.ShadingPattern 4
                WordBasic.CharRight 1
                Selection.Font.Size = 8
               
                WordBasic.ShadingPattern 4
                WordBasic.WordLeft 1
               
            Case MANDAG
                If Not IsHelligdag(DateSerial(aar, maaned, dag)) Then
                 
                    WordBasic.WordRight 1
                   
                    Call MakeTabel_SplitCell
                 
                       
                   
                    WordBasic.WordRight 1
                   
                 
                                     
                             
                                     
                    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
                  '  Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
                    Selection.Font.Color = wdColorBlack
                    WordBasic.Insert Str(WEEKNR(Str(datosn)))
                 
                    WordBasic.WordLeft 4
                End If
                               
            Case LØRDAG
                WordBasic.ShadingPattern 4
             
            Case Else
           
        End Select
       
       
       
       
        WordBasic.LineDown 1
        datosn = datosn + 1
        dag = dag + 1
        maaned = WordBasic.Month(datosn)
    Wend

    temp = WordBasic.Day(datosn)

    While temp <= 30
        WordBasic.BorderRight 0
        WordBasic.LineDown 1
        temp = temp + 1
    Wend

    WordBasic.EditBookmark Name:="her", SortBy:=0, GoTo:=1
    WordBasic.CenterPara
    WordBasic.LineDown 1
    WordBasic.CenterPara
    WordBasic.EditBookmark Name:="her", SortBy:=0, GoTo:=1
    WordBasic.BorderBottom 0
    WordBasic.NextCell
    aar = WordBasic.Year(datosn)
Next teller

WordBasic.StartOfDocument

GoTo slut

fejl:
WordBasic.MsgBox errtext$
GoTo start

slut:

End Sub

Pyh :-) Jeg er elendig til Wordbasic, så jeg kan ikke lige gennemskue alt hvad der foregår.

Mit input må ikke bare tages "råt for usødet", men som et eksempel på hvordan man nyopretter en tabel, splitter en specifik celle i 2, og deler bredden i den oprindelige celle så forholdet bliver 9:1.

Du kan tage eksemplet, modificere det lidt, så du får noget der ligner dette:

Public Sub SplitCellIn2(TabelNr As Long, RowNr As Long, ColNr As Long)
  Dim OrigWidth As Long
  With ActiveDocument.Tables(TabelNr)
      With .Cell(RowNr, ColNr)
        OrigWidth = .Width
        .Split NumColumns:=2
      End With
      .Cell(RowNr, ColNr).Width = OrigWidth * 0.9
      .Cell(RowNr, ColNr + 1).Width = OrigWidth * 0.1
  End With
End Sub

Public Sub MakeTabel_CallSplitCellIn2()
  Dim OrigWidth As Long
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=4, NumColumns:=2, AutoFitBehavior:=False
  SplitCellIn2 ActiveDocument.Tables.Count, 2, 2
End Sub

Vær opmærksom på at koden efterlader dig i en tilfældig celle (1,1) så du selv sørge for at få markøren anbragt i den rigtige celle.

Håber det kan bringe dig et skridt videre.

åbn svar

? :-)
Kom du videre?

lukket